6 # Close stderr, else inetd sends this back to the client.
15 use Sys::Syslog qw(:DEFAULT setlogsock);
17 $ENV{PATH} = "/usr/bin:/bin";
18 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
20 my $spooldir = "@SPOOLDIR@";
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;
29 my $hostname = hostname ();
31 # Open a connection to syslog.
33 openlog ("dlife_server", "pid,ndelay", "user");
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";
39 chroot $spooldir or die "chroot $spooldir: $!";
44 die "could not change UID successfully: $!" unless $> == $uid && $) == $gid;
46 chdir "/store" or die "$spooldir/store: $!";
48 # Pull out connection information.
49 my $peername = getpeername STDIN;
50 my ($peerport, $peeraddr) = unpack_sockaddr_in ($peername);
51 my $peeraddrstring = inet_ntoa ($peeraddr);
55 my $revhostname = gethostbyaddr ($peeraddr, AF_INET);
58 my $ipaddr = gethostbyname ($revhostname);
60 if ($ipaddr && inet_ntoa ($ipaddr) eq $peeraddrstring)
62 $peerhostname = $revhostname;
66 # Log connection information.
67 syslog ("info", "received connection from $peeraddrstring:$peerport" .
68 ($peerhostname ? " ($peerhostname)" : ""));
72 # Send greeting to client.
73 print "DLIFE SERVER $server_version $protocol_version\r\n";
75 # Loop, waiting for commands from the client.
81 # Remove trailing \r\n.
84 if (/^HELO\s+(.*)\s+(.*)$/)
86 do_HELO_command ($1, $2);
98 print "200 Goodbye.\r\n";
99 last; # Exit the loop.
103 # Unknown command. Return an error message.
104 print "500 Unknown command.\r\n";
112 my $remote_hostname = shift;
113 my $remote_client_version = shift;
115 syslog ("info", "client software version: $remote_client_version");
117 # Do nothing with this information for now.
118 print "200 Hello.\r\n";
123 if ($cells_uploaded > $max_cells_upload_per_pass)
125 print "500 Too many cells uploaded in this pass.\r\n";
129 print "100 OK. Send the cell, terminated by . <CR> <LF> on a line of its own.\r\n";
134 while (length ($cell) < 8192)
147 # Save the cell to a file.
148 my $rand = int (rand 1000000000);
149 open CELL, ">$rand.dlo" or die "$rand.dlo: $!";
155 syslog ("info", "received cell $rand.dlo");
158 print "200 Cell uploaded OK.\r\n";
163 if ($cells_downloaded > $max_cells_download_per_pass)
165 print "500 Too many cells downloaded in this pass.\r\n";
169 # Find a cell at random.
170 my @cells = glob_cells ();
173 print "400 I have no cells to send you. Try again later.\r\n";
178 my $cell_filename = $cells[$r];
180 unless (open CELL, "<$cell_filename")
182 print "400 Another process grabbed that cell before I could send it. Try again.\r\n";
187 print "100 OK. Sending you a cell now.\r\n";
189 syslog ("info", "sending cell $cell_filename");
199 unlink $cell_filename;
203 $cells_downloaded ++;
204 print "200 Finished sending the cell.\r\n";
207 # This function is equivalent to glob ("*.dlo"), except that
208 # the glob function doesn't work when tainting is enabled, alas.
211 opendir DIR, "." or die "$spooldir/store: $!";
212 my @names = map { untaint_string ($_) } grep { /\.dlo$/ } readdir DIR;