Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

gopher server in < 1024B

by beth (Scribe)
on May 11, 2004 at 08:06 UTC ( #352340=perlcraft: print w/ replies, xml ) Need Help??

   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: 

Comment on gopher server in < 1024B
Download Code
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"

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" . $/; }

    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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://352340]
Approved by grinder
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (6)
As of 2014-09-17 21:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (99 votes), past polls