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

    I think it's generally a good idea to use \015\012 instead of \r\n when doing something such as this (i.e. network coding). The reason is \n can change depending on what platform you're running. Hopefully this won't push you past the 1024 byte limit. 8^)

    For reference, this is documented in perlop, under the "Quote and Quote-like Operators" section, in the paragraph starting with "All systems use the"

[reply]
[d/l]
[select]
Re: gopher server in < 1024B
by dragonchild (Archbishop) on May 20, 2004 at 03:00 UTC
    Does this code actually work? I've been looking at golfing it and found a few oddities. Here's the code as run through B::Deparse: 
    BEGIN { $^W = 1; }
use IO::Socket;
use strict 'refs';
local $/ = "\r\n";
my $port = '7070';
my $root = '/home/beth/gopher/gopher';
die "can't chroot: $!\n" unless chroot $root;
local $SIG{'HUP'} = 'IGNORE';
exit if my $pid = fork;
die "Couldn't create socket: $!\n" unless my $sock = 'IO::Socket::INET
+'->new('LocalPort', $port, 'Type', SOCK_STREAM(), 'Listen', 1, 'Reuse
+', 1);
my $s = $sock->accept;
while (defined(my $req = <$s>)) {
    chomp(my $req = shift @ARGV);
    $req = '/' . $req;
    &error unless -r $req;
    $req .= '/.cache' if -d _;
    printfile($req);
    close $sock;
}
sub printfile {
    use strict 'refs';
    open FILE, shift @_;
    binmode FILE;
    print $s <FILE>;
    close FILE;
}
sub error {
    use strict 'refs';
    my $req = shift @_;
    print $s "iBad Request: $! \tfake\t(NULL)\t0" . $/;
}

    [download]

    Please note the following: (line#'s from your code)

    1. Lines 31 and 33 both assign to my $req. On 33, it's assigning to shift @ARGV.
    2. You assign $req to shift on line 51, but don't use it and don't pass anything in to error(), either.
    3. You don't use $pid from line 17. So, essentially, you're forking to create a child, then exiting the child immediately ... ?
    4. Unless I'm mistaken, you'll only ever serve one request for one client, then leave ... ?

    I'm not trying to rip it apart, but I couldn't understand it to golf it. :-(

    ------
    We are the carpenters and bricklayers of the Information Age.

    Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

    I shouldn't have to say this, but any code, unless otherwise stated, is untested

[reply]
[d/l]
[select]

Back to Craft