DC

#!/usr/local/bin/perl # httpdc # a completely useless tool - a dc desk calculator in the url # 2.3.+.dc.foor.bar will print out the html page # "5" # # this code assumes that a real server lurks behind port 8080 on the local host # use Socket; # the port I listen to $port=80; # the port I redirect all other requests to $http_port = 80 ; $AF_INET = 2 ; $SOCK_STREAM = 1 ; $sockaddr = 'S n a4 x8'; ($name, $aliases, $proto) = getprotobyname('tcp'); $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0"); socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(S, SOL_SOCKET, SO_REUSEADDR,1) ; bind(S,$this) || die "Bind: $!"; listen(S,5) || die "Connect: $!"; my $runas = 'nobody'; # Change effective id $> = getpwnam($runas); use Tie::Syslog; my $x=tie *LOG, 'Tie::Syslog', 'daemon.info','RPHTTPD','pid','unix'; #open(LOG,">>/root/RPNS/httpdc.log"); print(LOG "RPHTTPD Server Listening on port $port\n"); select(S); $|=1; select(LOG); $|=1; select(STDOUT); for ($con = 1 ; ; $con++) { sleep 1; ($addr = accept(NS,S)) || die $!; if (($child = fork()) == 0) { # &open_slave() ; # if (($child = fork()) == 0) { # select(NS); $|=1; select(STDOUT); # read_slave() ; # close(NS) ; # exit ; # } select(NS); $|=1; select(STDOUT); $host = "" ; while ($line = ) { # print (LOG "LINE: $line\n"); if ($line =~ /^GET\s+(\S*)/) { $url = $1 ; } elsif ($line =~ /^Host:\s+(.*)$/) { $host = $1 ; $host =~ s/\r// ; $host =~ s/\n// ; } push(@lines,$line) ; if ($line =~ /^\r*\n*$/) { if ($host =~ /^(.*)\.rp\./i) { process_host($host, $text); close (NS); } else { # &write_slave() ; } } } }else{ close(NS); } # &close_slave() ; close(NS) ; } exit ; ############################ sub process_host { my($host,$text) = @_ ; @types = ("text/html; charset=ISO-8859-1","text/plain; charset=ISO-8859-1","application/pdf","application/ps") ; @gmt = gmtime(time()) ; $day = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$gmt[6]]; $mon = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")[$gmt[4]]; $gmt[5] += 1900 ; $datestr = sprintf("%s, %02d %s %d %02d:%02d:%02d GMT",$day,$gmt[3],$mon,$gmt[5],$gmt[2],$gmt[1],$gmt[0]) ; # print(LOG "file: $host -> $text\n") ; if ($host =~ /^(.*)\.rp\./i) { $dcargs = $1; $dcargs =~ tr/A-Z/a-z/ ; $dcargs =~ s/\;// ; $dcargs =~ s/\'// ; $dcargs =~ s/\"// ; $dcargs =~ s/\./ / ; $dcargs .= " p" ; $infile = "/tmp/dci.$$" ; open(I,">$infile") ; print(I "$dcargs\n") ; close(I) ; $outfile = "/tmp/dco.$$" ; system("/usr/bin/dc <$infile >$outfile") ; if (!(-s $outfile)) { open(O,">$outfile") ; print(O "Beats me. Try using your toes as well as your fingers.\n") ; close(O) ; } $fout = "/tmp/dco.$$.html" ; open(FO,">$fout"); print(FO "DC") ; print(FO "\n") ; print(FO "

\n") ;
     open(I,"$outfile") ;
     while ($line = ) { print(FO $line) ; }
     close(I) ;
     print(FO "

\n") ; close(FO) ; $size = -s $fout ; print(NS "HTTP/1.1 200 OK\n") ; print(NS "Date: $datestr\n") ; print(NS "Server: The Bert reverse polish server\n") ; print(NS "Accept-Ranges: bytes\n") ; print(NS "Content-Length: $size\n") ; print(NS "Keep-Alive: timeout=15, max=100\n") ; print(NS "Connection: Keep-Alive\n") ; print(NS "Context-Type: $types[$text]\n\n") ; # print(LOG "HTTP/1.1 200 OK\n") ; # print(LOG "Date: $datestr\n") ; # print(LOG "Server: The Bert reverse polish server\n") ; # print(LOG "Accept-Ranges: bytes\n") ; # print(LOG "Content-Length: $size\n") ; # print(LOG "Keep-Alive: timeout=15, max=100\n") ; # print(LOG "Connection: Keep-Alive\n") ; # print(LOG "Context-Type: $types[$text]\n\n") ; open(I,"$fout") ; while ($buffer = ) { print(NS $buffer) ; # print(LOG $buffer) ; } print(NS "\n") ; unlink($infile) ; unlink($outfile) ; unlink($fout) ; } else { $fout = "/tmp/404.$$.txt" ; open(FO,">$fout"); print(FO "\n") ; print(FO "NO CLUE\n") ; print(FO "\n") ; print(FO "
Huh?
\n") ; print(FO "Beats me. Try using your toes as well as your fingers.
\n") ; print(FO "\n") ; close(FO) ; $size = -s $fout ; $fulf = $fout ; print(NS "HTTP/1.1 200 OK\n") ; print(NS "Date: $datestr\n") ; print(NS "Server: The Bert reverse polish server\n") ; print(NS "Content-Length: $size\n") ; print(NS "Keep-Alive: timeout=15, max=100\n") ; print(NS "Connection: Keep-Alive\n") ; print(NS "Content-Type: text/html; charset=iso-8859-1\n\n") ; # print(LOG "HTTP/1.1 200 OK\n") ; # print(LOG "Date: $datestr\n") ; # print(LOG "Server: The Bert reverse polish server\n") ; # print(LOG "Content-Length: $size\n") ; # print(LOG "Keep-Alive: timeout=15, max=100\n") ; # print(LOG "Connection: Keep-Alive\n") ; # print(LOG "Content-Type: text/html; charset=iso-8859-1\n\n") ; open(I,"$fulf") ; while ($buffer = ) { print(NS $buffer) ; } unlink($fulf) ; } } sub open_slave { chop($http_hostname = `bert.secret-wg.org`); $http_defhost = $http_hostname ; $HTTP_AF_INET = 2 ; $HTTP_SOCK_STREAM = 1 ; $http_sockaddr = 'S n a4 x8'; ($http_name, $http_aliases, $http_proto) = getprotobyname('tcp'); ($http_name, $http_aliases, $http_type, $http_len, $http_thisaddr) = gethostbyname($http_hostname); (@http_v) = unpack('C4', $http_thisaddr); ($http_name, $http_aliases, $http_type, $http_len, $http_thataddr) = gethostbyname($http_defhost); (@http_w) = unpack('C4', $http_thataddr); $http_this = pack($http_sockaddr, $HTTP_AF_INET, 0, $http_thisaddr); $http_that = pack($http_sockaddr, $HTTP_AF_INET, $http_port, $http_thataddr); socket(H, $HTTP_AF_INET, $HTTP_SOCK_STREAM, $http_proto) || die "socket: $!"; bind(H, $http_this) || die "bind: $!"; connect(H, $http_that) || die "connect: $!"; select(H) ; $| = 1 ; select(STDOUT); } sub read_slave { while ($len = sysread(H, $buffer,16384)) { print(NS $buffer); print(LOG "$con:<-\t$buffer"); $offset = 0 ; while($len) { $written = syswrite(NS, $buffer, $len, $offset); $offset += $written ; $len -= $written ; } } close(H) ; } sub write_slave { select(H); $|=1; select(STDOUT); foreach $line (@lines) { print(LOG "$con:->\t$line"); print(H $line) ; } $#lines = -1 ; } sub close_slave { if ($#lines >= 0) { &write_slave() ; } close(H) ; }