1: #!/usr/bin/perl -w 2: # pocketgopher - an RFC-1436 compliant gopher server in < 1024B 3: # Beth Skwarecki 2004 4: # This program is free software under the GNU GPL 5: use strict; 6: use IO::Socket; 7: local $/ = "\015\012"; 8: 9: #### CONFIGURATION 10: my $port = '7070'; 11: my $root = '/home/beth/gopher/gopher'; 12: #### THAT IS ALL 13: 14: chroot $root or die "can't chroot: $!\n"; 15: 16: # fork 17: local $SIG{HUP} = 'IGNORE'; 18: exit if (my $pid = fork); 19: 20: 21: # listen 22: my $sock = new IO::Socket::INET 23: (LocalPort => $port, 24: Type => SOCK_STREAM, 25: Listen => 1, 26: Reuse => 1 27: ) or die "Couldn't create socket: $!\n"; 28: 29: 30: # serve 31: my $s = $sock->accept(); 32: while(my $req = <$s>){ 33: 34: chomp (my $req = shift); 35: $req = '/'.$req; 36: 37: &error unless (-r $req); 38: $req .= '/.cache' if ( -d _ ); 39: printfile($req); 40: close($sock); 41: } 42: 43: 44: sub printfile { 45: open (FILE, shift); 46: binmode FILE; 47: print $s <FILE>; 48: close FILE; 49: } 50: 51: sub error { 52: my $req = shift; 53: print $s "iBad Request: $! \tfake\t(NULL)\t0".$/; 54: } 55: 56: 57: ---------------------------- 58: (code is over, notes follow) 59: 60: 2004-05-12: 61: - changed $/ to \015\012 (thanks revdiablo) 62: - did a binmode() on the filehandle (thanks Corion) 63: 64: These changes improve things to serve gopher clients on 65: different platforms; however, the code still assumes that 66: the server is running on a unix-oid OS. 67:
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: gopher server in < 1024B
by revdiablo (Prior) on May 11, 2004 at 16:53 UTC | |
Re: gopher server in < 1024B
by dragonchild (Archbishop) on May 20, 2004 at 03:00 UTC |
Back to
Craft