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

Blog dir can be relocated

Browse source
This commit is contained in:
Thomas Schwery 2010-08-18 13:49:46 +02:00
parent 7c46f3ad20
commit be857877d3
1 changed files with 12 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gopher.pl
View file

@ -21,9 +21,10 @@ use Date::Parse;
use Date::Format;
use threads;
our ($port) = @ARGV;
our ($port, $basedir, $server) = @ARGV;
print "Port is " . $port . "\n";
print "Base dir is " . $basedir . "\n";
$SIG{INT} = \&signal_handler_interrupt;
@ -45,19 +46,14 @@ sub connection_thread {
s/\t.*//g; # Don't care about the parameters now ...
my $directory = $_;
$directory =~ s/^blog\///;
$directory = $basedir . "/" . $directory;
if (-f $directory) {
if (substr($directory, 0, 4) eq "blog") {
$listen_socket->send(send_blog_entry($directory));
} else {
open FILE, $directory;
while (<FILE>) {
$listen_socket->send($_);
}
$listen_socket->send("\r\n.\r\n") if (-T $directory);
}
$listen_socket->send(send_blog_entry($directory));
} else {
my $header = generate_header($directory);
my $blog_entries = list_blog_entries();
my $blog_entries = list_blog_entries($directory);
$listen_socket->send($header . "\r\n");
$listen_socket->send("\r\n");
@ -89,9 +85,11 @@ sub generate_header {
sub map_content {
my ($dir_entry, $directory) = @_;
$directory .= "/" if ($directory);
my $file_type = -f $directory . $dir_entry ? 0 : 1;
$file_type = 9 if (-f $directory . $dir_entry && -B $directory . $dir_entry);
return $file_type . $dir_entry . "\t" . $directory . $dir_entry . "\tlocalhost\t" . $port;
return $file_type . $dir_entry . "\t" . $dir_entry . "\tlocalhost\t" . $port;
}
sub filter_content {
@ -102,7 +100,7 @@ sub filter_content {
}
sub list_blog_entries {
my $blog_dir = "blog";
my ($blog_dir) = @_;
unless (opendir(IMD, $blog_dir)) {
die("Fuck you all ...");
}
@ -147,7 +145,7 @@ sub read_entry_file {
sub map_blog_entry {
my ($entry_file, $entry_dir) = @_;
my $entry_title = read_entry_file($entry_dir . "/" . $entry_file);
return "0" . $entry_title . "\t" . $entry_dir . "/" . $entry_file . "\tlocalhost\t" . $port;
return "0" . $entry_title . "\t" . "blog/" . $entry_file . "\t" . $server . "\t" . $port;
}
sub send_blog_entry {