tschwery/perl-gopher-server
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Checking file existance and sending error msg, less newlines for less bogus entries, header is in same dir as script instead of blog dir

Browse source
This commit is contained in:
Thomas Schwery 2010-09-14 11:21:36 +02:00
parent 65ba4893d4
commit afcdca0361
1 changed files with 18 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gopher.pl
View file

@ -56,20 +56,27 @@ sub connection_thread {
$directory = $basedir . "/" . $directory;
$directory =~ s/\/$//;
unless (-e $directory) {
print("Requested file or directory not readable : $directory \n");
$listen_socket->send("No entry found with this name ...\r\n");
$listen_socket->send(".\r\n");
return 0;
}
if (-f $directory) {
$listen_socket->send(send_blog_entry($directory));
$listen_socket->send(".\r\n");
} else {
my $header = generate_header($directory);
my $header = generate_header(".");
my $blog_entries = list_blog_entries($directory);
my $tags_entries = list_entries_by_tag($directory);
$listen_socket->send($header . "\r\n");
$listen_socket->send("\r\n");
$listen_socket->send($header);
$listen_socket->send("i----- Blog entries ---------------\tfake\tfake\t0\r\n");
$listen_socket->send($blog_entries . "\r\n");
$listen_socket->send($blog_entries);
$listen_socket->send("i----- Blog entries by tags---------------\tfake\tfake\t0\r\n");
$listen_socket->send($tags_entries . "\r\n");
$listen_socket->send("\r\n.\r\n");
$listen_socket->send($tags_entries);
$listen_socket->send(".\r\n");
}
$listen_socket->close();
@ -81,15 +88,16 @@ sub generate_header {
my ($directory) = @_;
$directory .= "/" if ($directory);
return "\r\n" unless (-T $directory . "header");
return "" unless (-T $directory . "header");
my $message = "";
open FILE, $directory . "header";
while (<FILE>) {
s/\r*\n*//g;
$message .= "i" . $_ . "\tfake\tfake\t0\r\n";
}
close FILE;
$message .= "0About this gopher server\theader\t" . $server . "\t" . $port . "\r\n";
#$message .= "0About this gopher server\theader\t" . $server . "\t" . $port . "\r\n";
return $message;
}
@ -114,7 +122,7 @@ sub filter_content {
sub list_blog_entries {
my ($blog_dir) = @_;
unless (opendir(IMD, $blog_dir)) {
die("Requested file or directory not readable : $blog_dir ");
return "";
}
my @files = readdir(IMD);
closedir(IMD);
@ -123,7 +131,7 @@ sub list_blog_entries {
@files = map map_blog_entry($_, $blog_dir), @files;
@files = sort sort_entry_line($a,$b), @files;
return join("\r\n", @files);
return join "\r\n", @files;
}
sub list_entries_by_tag {