Skip to content

Commit

Permalink
cage cleaning, bitrot removal, documentation brought up to date
Browse files Browse the repository at this point in the history
  • Loading branch information
Martin Berends committed Apr 8, 2009
1 parent 6083c36 commit 08e4de0
Show file tree
Hide file tree
Showing 4 changed files with 50 additions and 163 deletions.
45 changes: 25 additions & 20 deletions bin/httpd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,12 @@ defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();

# Serve one page
sub request {
# Currently executed in a child process of netcat - inefficient
# Currently executed in a child process of socat - inefficient
my HTTP::Daemon $d .= new;
while my HTTP::Daemon::ClientConn $c = $d.accept {
while my HTTP::Request $r = $c.get_request {
my $method = $r.req_method; # dodgy to call it 'method' in Perl 6
if $r.req_method eq 'GET' { # and $r.url.path ne '/favicon.ico' {
# my $method = $r.req_method; # risky to call it 'method' in Perl 6
if $r.req_method eq 'GET' { # risky to call it 'method' in Perl 6
# log request info to the standard error stream
warn "{hhmm} GET {$r.url.path} {$r.header('User-Agent')}";
given $r.url.path { # the web server's "directory"
Expand Down Expand Up @@ -61,8 +61,9 @@ All you need are the
and
<a href="http://github.com/eric256/perl6-examples/tree/master/lib/HTTP/Makefile">lib/HTTP/Makefile</a>
files from there, the
<a href="http://en.wikipedia.org/wiki/Netcat">netcat</a> utility in Unix
or Linux, and of course <a href="http://parrot.org">Parrot</a>.<p/>
<a href="http://www.dest-unreach.org/socat/">socat</a> utility in Unix
or Linux, and of course <a href="http://rakudo.org">Rakudo</a>
and <a href="http://parrot.org">Parrot</a>.<p/>
{page_bottom($c,$r)}];
$c.send_response( $html );
}
Expand Down Expand Up @@ -299,41 +300,45 @@ httpd - HyperText Transfer Protocol Daemon or Perl 6 (Rakudo) web server
git clone git://github.com/eric256/perl6-examples.git
cd perl6-examples/lib/HTTP
make clean
make all
make run
perl6 Configure
make help
make LOCALADDR=127.0.0.1 run
=head1 DESCRIPTION
This program runs a simple web server within itself, so there is no need
for Apache, IIS, mod_perl or other products. It must temporarily use the
Unix L<man:netcat> utility for the TCP part, but as soon as Rakudo gets
a more complete Input/Output library that dependency will be removed.
The overhead of communicating through netcat is two process forks per
Unix L<man:socat> utility for the TCP part, but will soon use the socket
functions in Parrot and Rakudo.
The overhead of communicating through socat is two process forks per
browser request, plus the Perl 6 parse and compile times.
The performance will definitely improve a lot when Rakudo takes over the
I/O.
Performance will definitely improve a lot when Rakudo handle the I/O
in-process.
This program uses L<doc:HTTP::Daemon> for the low level work. Thus the
the programmer can concentrate on the web content, as this source code
shows.
=head1 INSTALLATION
The default settings assume that parrot and perl6-examples are installed
in the same parent directory.
For other configurations, read about PARROT_DIR in the Makefile.
Follow the L<synopsis|doc:httpd#SYNOPSIS> with possibly your own values
for LOCALADDR and LOCALPORT, because the default 127.0.0.1:8888 works
only for a browser on the same host. Firewalls permitting, any address
you can ping from other hosts should work.
=head1 COMPATIBILITY
The API is designed to help migrate similar Perl 5 based servers. It is
completely original code written whilst referencing the corresponding
Perl 5 equivalent documentation.
completely original code written whilst matching the corresponding Perl
5 equivalent documentation. The migration to Parrot and Rakudo socket
functions will attempt to maintain this compatibility if possible.
Network compatibility is approximately HTTP 1.0, but is not verified.
=head1 BUGS
Bug reports and suggestions are very welcome.
Bug reports and suggestions are very welcome. The most common problem is
not having B<socat> installed, read L<doc:HTTP::Daemon> to fix that.
Nag the author via #perl6 on irc.freenode.net - any interest is welcome.
This L<doc:httpd> may give errors running with certain revisions of
Rakudo. They most recently worked together in Rakudo r37432.
Rakudo or Parrot. The Rakudo of 2009-04-07 and Parrot r37973 were ok.
=head1 SEE ALSO
<doc:HTTP::Daemon>
Expand Down
0 lib/HTTP/Configure.p6 → lib/HTTP/Configure
View file
File renamed without changes.
166 changes: 24 additions & 142 deletions lib/HTTP/Daemon.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,125 +5,6 @@

# only a subset emulation of the Perl 5 HTTP::Headers design - no tuits!

# Interim subs to expose Parrot socket functions (r37707) in Rakudo.
# Names and parameters correspond to the Perl 5 definitions, not the
# sometimes different BSD Socket ones that Parrot actually provides.
# Read 'perldoc perlipc' and search for Sockets for the explanation.

# subs 'Under Construction': nothing works or even makes sense!

#sub socket( IO $socket, $domain, $type, $protocol ) {
# # $socket handle to be opened
# # $domain ?=PF_INET (read 'man socket')
# # $type ?=SOCK_STREAM ?=SOCK_DGRAM
# # $protocol is 'udp' | 'tcp'
# # returns Bool::True for success or Bool::False for failure
# q:PIR{ # from q:PIR in socket() in Daemon.pm
# .local pmc sock
# $P0 = socket 2,1,0 # guessing that's domain, type, protocol
# socket sock, 2, 1, 6 # PF_INET, SOCK_STREAM, tcp##
#
# %r = $P0
# }
#}

#sub setsockopt( IO $socket, Int $level, Int $optname, Str $optval ) {
# # $optval is a string containing packed binary data
# # returns Bool::True for success or Bool::False for failure
# q:PIR{ # from q:PIR in setsockopt() in Daemon.pm
# }
#}

#sub sockaddr_in( Int $port, $iaddr ) {
# # $port obtained from getservbyname()
# # $iaddr is a packed binary structure obtained from gethostbyname()
# my $sin = q:PIR{ # from q:PIR in sockaddr_in() in Daemon.pm
# %r = box '123'
# };
# return $sin;
#}

#sub bind( IO $socket, $packed_address ) {
# # returns Bool::True for success or Bool::False for failure
# return q:PIR{ # from q:PIR in listen() in Daemon.pm
# get_hll_global $P0, ["Bool"], "True"
# .local int ret
# .local pmc sock
# .local pmc address
# ret = bind sock, address
# %r = $P0
# }
#}

#sub listen( IO $socket, Int $queuesize ) {
# # returns Bool::True for success or Bool::False for failure
# return q:PIR{ # from q:PIR in listen() in Daemon.pm
# get_hll_global $P0, ["Bool"], "True"
# .local int ret
# .local pmc sock
# listen ret, sock, 1
# %r = $P0
# }
#}

#sub accept( IO $newsocket, IO $genericsocket ) {
# # returns the packed remote address for success or Bool::False for failure
# return q:PIR{ # from q:PIR in accept() in Daemon.pm
# get_hll_global $P0, ["Bool"], "False"
# .local pmc work
# .local pmc sock
# accept work, sock
# %r = $P0
# }
#}

#sub connect( IO $socket, Str $address ) {
# # the Perl 5 version expects a packed binary $address for total C
# # compatibility, but 'host.domain.com:1234' is nicer.
# my Bool $success;
# $success = Bool::True;
# $success = q:PIR{ # from q:PIR in connect() in Daemon.pm
# get_hll_global $P0, ["Bool"], "True"
# %r = $P0
# };
# return $success;
#}

#sub send( $handle, $message, $flags, $sin? ) {
# # $handle created by socket()
# # $message
# # $sin used with unconnected (eg udp) sockets but not connected (tcp) ones
# my $characters_sent;
# $characters_sent = q:PIR{ # from q:PIR in send() in Daemon.pm
# new $P0, "Int"
# $P1 = "undef"()
# "infix:="($P0, $P1) # set result to undef in the event of error
# assign $P0, 1234 # number of characters sent
# %r = $P0
# };
# return $characters_sent; # must return undef if error
#}

#sub read( IO $handle, Str $buffer, Int $character_count, Int $offset? ) {
# # $handle created by socket()
# # $buffer receives the incoming characters
# # $character_count indicates maximum number of characters to receive
# # $offset indicates where in buffer to begin receiving characters
# my Int $characters_received; # and undef means error, 0 means EOF
# $characters_received = 5432;
# $characters_received = undef;
# $characters_received = q:PIR{ # from q:PIR in read() in Daemon.pm
# new $P0, "Int"
# $P1 = "undef"()
# "infix:="($P0, $P1) # set result to undef in the event of error
# assign $P0, 1234 # number of characters received
# %r = $P0
# };
# return $characters_received;
#}

# End interim subs

class HTTP::Headers {
has %!header_values;
method header( Str $fieldname ) {
Expand Down Expand Up @@ -218,14 +99,14 @@ class HTTP::Daemon::ClientConn {
# the internet newline is 0x0D 0x0A, "\n" would vary between OSes
method send_crlf { print "\x0D\x0A"; }

# untested so far
# now tested with /favicon.ico
method send_file_response( $self: Str $filename ) {
$self.send_basic_header;
$self.send_crlf;
$self.send_file( $filename );
}

# untested so far
# now tested with /favicon.ico
method send_file( Str $filename ) {
my $contents = slurp( $filename );
print $contents;
Expand All @@ -244,24 +125,23 @@ class HTTP::Daemon::ClientConn {
}

# seems inefficient
multi method send_error( $self: Str $message ) {
multi method send_error( Str $message ) {
my %status = (
'OK' => 200,
'RC_FORBIDDEN' => 403,
'RC_NOTFOUND' => 404,
'RC_INTERNALERROR' => 500,
'RC_NOTIMPLEMENTED' => 501
);
$self.send_error( %status{$message}, $message );
self.send_error( %status{$message}, $message );
}

multi method send_error( $self: Int $status, Str $message ) {
$self.send_status_line( $status, $message );
$self.send_crlf;
multi method send_error( Int $status, Str $message ) {
self.send_status_line( $status, $message );
self.send_crlf;
say "<title>$status $message</title>";
say "<h1>$status $message</h1>";
}

}

grammar HTTP::headerline {
Expand All @@ -278,13 +158,11 @@ class HTTP::Daemon
has Bool $!accepted;

method daemon {
my $perl6 = %*ENV<PERL6>;
# warn "perl6: $perl6";
$!running = Bool::True;
while $!running {
# spawning socat here is a temporary measure until
# Rakudo gets socket(), listen(), accept() etc.
my Str $command = "$perl6 $*PROGRAM_NAME --request";
my Str $command = "perl6 $*PROGRAM_NAME --request";
run( "socat TCP-LISTEN:{$.port},bind={$.host},fork EXEC:'$command'" );
# previous versions used netcat, but on BSD lacked -c and -e
# run( "netcat -c '$command' -l -s {$.host} -p {$.port} -v" );
Expand All @@ -300,7 +178,7 @@ class HTTP::Daemon
# flag when it has returned one client connection and always returns
# undef when called a second time, because by then the netcat client
# connection will be gone.
# This is also why netcat cannot do HTTP 1.1 chunked transfer.
# This is also why netcat/socat cannot do HTTP 1.1 chunked transfer.
method accept {
if defined $!accepted { return undef; }
else {
Expand All @@ -320,7 +198,7 @@ HTTP::Daemon - a (very) simple web server using Rakudo Perl 6
git clone git://github.com/eric256/perl6-examples.git
cd perl6-examples/lib/HTTP
perl6 Configure.p6
perl6 Configure
make help
make LOCALADDR=127.0.0.1 run
Expand All @@ -343,8 +221,6 @@ Internet security breaches.
=head2 Small but working
=begin code
#!/usr/local/bin/perl6
use v6;
use HTTP::Daemon;
defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();
Expand All @@ -353,8 +229,7 @@ sub request {
my HTTP::Daemon $d .= new;
while my HTTP::Daemon::ClientConn $c = $d.accept {
while my HTTP::Request $r = $c.get_request {
my $method = $r.method;
if $r.method eq 'GET' {
if $r.req_method eq 'GET' {
given $r.url.path {
when '/' { root_dir( $c, $r ); }
when / ^ \/pub\/ $ / { pub_dir( $c, $r ); }
Expand Down Expand Up @@ -405,7 +280,7 @@ sub request {
my HTTP::Daemon $d .= new;
while my HTTP::Daemon::ClientConn $c = $d.accept {
while my HTTP::Request $r = $c.get_request {
if $r.method eq 'GET' and $r.url.path eq '/xyzzy' {
if $r.req_method eq 'GET' and $r.url.path eq '/xyzzy' {
# remember, this is *not* recommended practice :-)
$c.send_file_response("/etc/passwd");
}
Expand All @@ -418,33 +293,39 @@ sub request {
sub daemon {
my HTTP::Daemon $d .= new( host=>'127.0.0.1', port=>2080 );
$d.temporary_set_prog( './test.pl' );
say "Browse this Perl 6 web server at {$d.url}";
$d.daemon();
}
=end code
=head1 DEPENDENCIES
The Daemon start a subprocess with C<perl6> so the Rakudo C<perl6> fake
executable must be in a search path directory, or symbolically linked to
one. For example, in Linux:
sudo ln --symbolic --force /path/to/rakudo/perl6 /usr/local/bin/
perl6 -v # just checking that perl6 is now in the search path
Temporarily (see L<#TODO>) HTTP::Daemon depends on the L<man:socat>
utility to receive and send on a TCP port.
On Debian based Linux distributions, this should set it up:
sudo apt-get install socat
On BSD systems including AIX:
On BSD systems including OSX:
sudo port install socat
=head1 BUGS
This L<doc:HTTP::Daemon> may fail with certain Rakudo revisions.
The most recent successfully tested Rakudo revision is Parrot r37432.
This L<doc:HTTP::Daemon> may fail with certain Rakudo revisions, it
worked with the Rakudo of 2009-04-07 and Parrot r37973.
=head1 SEE ALSO
The Makefile comments describe additional testing options.
L<socat|http://www.dest-unreach.org/socat/> provides the Sockets that
Parrot and Rakudo lack.
Its predecessor L<man:netcat(1)> calls itself a TCP/IP swiss army knife.
Its predecessor L<man:netcat(1)> was called the TCP/IP swiss army knife.
HTTP 1.1 (L<http://www.ietf.org/rfc/rfc2616.txt>) describes all methods
and status codes.
Expand All @@ -453,3 +334,4 @@ and status codes.
Martin Berends (mberends on CPAN github #perl6 and @autoexec.demon.nl).
=end pod

2 changes: 1 addition & 1 deletion lib/Pod/to/xhtml.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ class Pod::to::xhtml is Pod::Parser
has Int $!indentlevel;
has Str $!name;
has Str $!prefix;
has Str $!buffer;
has Str $!buffer; # TODO: defer to same in Pod::Parser
has Bool $!do_emit;
has Bool $!do_definition;
has Str $!definition;
Expand Down

0 comments on commit 08e4de0

Please sign in to comment.