#!/usr/bin/perl ##################################### # Thomas Schwery #################################### # # TODO: # - Support for a list of tags # - Default port if failure # - ... use strict; use IO::Socket; use Fcntl ':mode'; use Privileges::Drop; use HTML::Parse; use HTML::FormatText; use Text::Wrap; use Date::Parse; use Date::Format; use threads; use Clone qw(clone); our ($port, $basedir, $server) = @ARGV; print "Port is " . $port . "\n"; print "Base dir is " . $basedir . "\n"; $SIG{INT} = \&signal_handler_interrupt; $SIG{PIPE} = \&signal_handler_pipe; my $socket = new IO::Socket::INET(LocalPort => $port, Proto => 'tcp', Listen => '1', Reuse => 1); die "Unable to open port: $! \n" unless $socket; drop_privileges('nobody'); our %tags_entries; while (1) { my $listen_socket = $socket->accept(); my $thr = threads->create(\&connection_thread, $listen_socket); $thr->detach(); } sub connection_thread { my ($listen_socket) = @_; $_ = <$listen_socket>; s/\r*\n*//g; s/\t.*//g; # Don't care about the parameters now ... my $directory = $_; $directory =~ s/^blog\///; $directory =~ s/[.\/]//g; $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("."); my $blog_entries = list_blog_entries($directory); my $tags_entries = list_entries_by_tag($directory); $listen_socket->send($header); $listen_socket->send("i----- Blog entries ---------------\tfake\tfake\t0\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); $listen_socket->send(".\r\n"); } $listen_socket->close(); return 0; } sub generate_header { my ($directory) = @_; $directory .= "/" if ($directory); return "" unless (-T $directory . "header"); my $message = ""; open FILE, $directory . "header"; while () { 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"; return $message; } 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" . $dir_entry . "\tlocalhost\t" . $port; } sub filter_content { my ($dir_entry, $blog_dir) = @_; return 0 unless -r $blog_dir."/".$dir_entry; return 1 unless (substr($dir_entry,0,1) eq "." || $dir_entry eq "header"); return 0; } sub list_blog_entries { my ($blog_dir) = @_; unless (opendir(IMD, $blog_dir)) { return ""; } my @files = readdir(IMD); closedir(IMD); @files = grep filter_content($_, $blog_dir), @files; @files = map map_blog_entry($_, $blog_dir), @files; @files = sort sort_entry_line($a,$b), @files; return join "\r\n", @files; } sub list_entries_by_tag { my $entries; my %tags_entries_local = %{ clone (\%tags_entries) }; foreach my $tag (sort keys %tags_entries_local) { $entries .= "i----- " . $tag . " ---------------\tfake\tfake\t0\r\n"; foreach my $entry (@{$tags_entries_local{$tag}}) { $entry =~ m/^(.*)\/(.*)$/; my $entry_dir = $1; my $entry_name = $2; $entries .= map_blog_entry($entry_name, $entry_dir) . "\r\n"; } } return $entries; } sub sort_entry_line { my $a_date = $2 if ($a =~ m/^0(\[.*\]\s)?(.*?)\s*-.*$/); my $b_date = $2 if ($b =~ m/^0(\[.*\]\s)?(.*?)\s*-.*$/); return -(str2time($a_date) <=> str2time($b_date)); } sub read_entry_file { my ($entry_file) = @_; my $subject = ""; my $date_file = ""; my $tags = ""; open ENTRY, $entry_file; while () { s/\r*\n*//g; $subject = $1 if (m/^Subject:\s*(.*)$/); $tags = $1 if (m/^Tags:\s*(.*)$/); $date_file = $1 if (m/^Date:\s*(.*)$/); } close ENTRY; my @tag_list = split ',',$tags; foreach my $tag (@tag_list) { push @{ $tags_entries{$tag} }, $entry_file; } my $time = str2time($date_file); my $date = time2str("%o %h %Y", $time); return "[" . $tags . "] " . $date . " - " . $subject if($tags); return $date. " - " . $subject; } sub map_blog_entry { my ($entry_file, $entry_dir) = @_; my $entry_title = read_entry_file($entry_dir . "/" . $entry_file); return "0" . $entry_title . "\t" . "blog/" . $entry_file . "\t" . $server . "\t" . $port; } sub send_blog_entry { my ($entry_file) = @_; open FILE, $entry_file; my $entry_text = ""; while () { $entry_text .= $_; } $entry_text =~ s/\r?\n/
/mg; my $plain_text = HTML::FormatText->new->format(parse_html($entry_text)); $Text::Wrap::columns = 80; $plain_text = wrap("\t", "", $plain_text); return $plain_text; } sub signal_handler_interrupt { print "ctrl-c, exiting...\n"; $socket->shutdown(2); $socket->close(); exit 0; } sub signal_handler_pipe { print "sigpipe, don't care\n"; return 0; }