dlife_server.pl.in

   1 #!/usr/bin/perl -w -T
   2 # -*- perl -*-
   3 # @configure_input@
   4
   5 BEGIN {
   6   # Close stderr, else inetd sends this back to the client.
   7   close STDERR;
   8 };
   9
  10 use strict;
  11
  12 use Socket;
  13 use IO::Socket;
  14 use Sys::Hostname;
  15 use Sys::Syslog qw(:DEFAULT setlogsock);
  16
  17 $ENV{PATH} = "/usr/bin:/bin";
  18 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
  19
  20 my $spooldir = "@SPOOLDIR@";
  21 my $user = "dlife";
  22 my $server_version = "@VERSION@";
  23 my $protocol_version = "1.0";
  24 my $cells_uploaded = 0;
  25 my $cells_downloaded = 0;
  26 my $max_cells_upload_per_pass = 8;
  27 my $max_cells_download_per_pass = 8;
  28
  29 my $hostname = hostname ();
  30
  31 # Open a connection to syslog.
  32 setlogsock ("unix");
  33 openlog ("dlife_server", "pid,ndelay", "user");
  34
  35 # Chroot into the spool directory and change our UID/GID so we are safe.
  36 my ($login, $pass, $uid, $gid) = getpwnam ($user)
  37   or die "$user: user not found in password file";
  38
  39 chroot $spooldir or die "chroot $spooldir: $!";
  40
  41 $) = $gid;
  42 $> = $uid;
  43
  44 die "could not change UID successfully: $!" unless $> == $uid && $) == $gid;
  45
  46 chdir "/store" or die "$spooldir/store: $!";
  47
  48 # Pull out connection information.
  49 my $peername = getpeername STDIN;
  50 my ($peerport, $peeraddr) = unpack_sockaddr_in ($peername);
  51 my $peeraddrstring = inet_ntoa ($peeraddr);
  52
  53 my $peerhostname;
  54
  55 my $revhostname = gethostbyaddr ($peeraddr, AF_INET);
  56 if ($revhostname)
  57   {
  58     my $ipaddr = gethostbyname ($revhostname);
  59
  60     if ($ipaddr && inet_ntoa ($ipaddr) eq $peeraddrstring)
  61       {
  62         $peerhostname = $revhostname;
  63       }
  64   }
  65
  66 # Log connection information.
  67 syslog ("info", "received connection from $peeraddrstring:$peerport" .
  68         ($peerhostname ? " ($peerhostname)" : ""));
  69
  70 $| = 1;
  71
  72 # Send greeting to client.
  73 print "DLIFE SERVER $server_version $protocol_version\r\n";
  74
  75 # Loop, waiting for commands from the client.
  76 for (;;)
  77   {
  78     alarm 60;
  79     $_ = <STDIN>;
  80
  81     # Remove trailing \r\n.
  82     s/[\r\n]+$//;
  83
  84     if (/^HELO\s+(.*)\s+(.*)$/)
  85       {
  86         do_HELO_command ($1, $2);
  87       }
  88     elsif (/^STOR$/)
  89       {
  90         do_STOR_command ();
  91       }
  92     elsif (/^RETR$/)
  93       {
  94         do_RETR_command ();
  95       }
  96     elsif (/^QUIT$/)
  97       {
  98         print "200 Goodbye.\r\n";
  99         last;                   # Exit the loop.
 100       }
 101     else
 102       {
 103         # Unknown command. Return an error message.
 104         print "500 Unknown command.\r\n";
 105       }
 106   }
 107
 108 exit 0;
 109
 110 sub do_HELO_command
 111   {
 112     my $remote_hostname = shift;
 113     my $remote_client_version = shift;
 114
 115     syslog ("info", "client software version: $remote_client_version");
 116
 117     # Do nothing with this information for now.
 118     print "200 Hello.\r\n";
 119   }
 120
 121 sub do_STOR_command
 122   {
 123     if ($cells_uploaded > $max_cells_upload_per_pass)
 124       {
 125         print "500 Too many cells uploaded in this pass.\r\n";
 126         return;
 127       }
 128
 129     print "100 OK. Send the cell, terminated by . <CR> <LF> on a line of its own.\r\n";
 130
 131     # Read in the cell.
 132     my $cell = "";
 133
 134     while (length ($cell) < 8192)
 135       {
 136         alarm 10;
 137         $_ = <STDIN>;
 138         alarm 0;
 139
 140         s/[\n\r]*$//;
 141
 142         last if $_ eq ".";
 143
 144         $cell .= $_ . "\n";
 145       }
 146
 147     # Save the cell to a file.
 148     my $rand = int (rand 1000000000);
 149     open CELL, ">$rand.dlo" or die "$rand.dlo: $!";
 150
 151     print CELL $cell;
 152
 153     close CELL;
 154
 155     syslog ("info", "received cell $rand.dlo");
 156
 157     $cells_uploaded ++;
 158     print "200 Cell uploaded OK.\r\n";
 159   }
 160
 161 sub do_RETR_command
 162   {
 163     if ($cells_downloaded > $max_cells_download_per_pass)
 164       {
 165         print "500 Too many cells downloaded in this pass.\r\n";
 166         return;
 167       }
 168
 169     # Find a cell at random.
 170     my @cells = glob_cells ();
 171     if (@cells == 0)
 172       {
 173         print "400 I have no cells to send you. Try again later.\r\n";
 174         return;
 175       }
 176
 177     my $r = rand @cells;
 178     my $cell_filename = $cells[$r];
 179
 180     unless (open CELL, "<$cell_filename")
 181       {
 182         print "400 Another process grabbed that cell before I could send it. Try again.\r\n";
 183         return;
 184       }
 185
 186     # Send it.
 187     print "100 OK. Sending you a cell now.\r\n";
 188
 189     syslog ("info", "sending cell $cell_filename");
 190
 191     while (<CELL>)
 192       {
 193         s/[\n\r]+$//;
 194         print $_, "\r\n";
 195       }
 196
 197     close CELL;
 198
 199     unlink $cell_filename;
 200
 201     print ".\r\n";
 202
 203     $cells_downloaded ++;
 204     print "200 Finished sending the cell.\r\n";
 205   }
 206
 207 # This function is equivalent to glob ("*.dlo"), except that
 208 # the glob function doesn't work when tainting is enabled, alas.
 209 sub glob_cells
 210   {
 211     opendir DIR, "." or die "$spooldir/store: $!";
 212     my @names = map { untaint_string ($_) } grep { /\.dlo$/ } readdir DIR;
 213     closedir DIR;
 214     return @names;
 215   }
 216
 217 sub untaint_string
 218   {
 219     my $s = shift;
 220     $s =~ /^(.*)$/;
 221     return $1;
 222   }