Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

remove files that now live at http://gitorious.org/http-daemon

  • Loading branch information...
commit 576f6152cb174461677942cba983c634ed9b8501 1 parent 8f364e6
@mberends mberends authored
View
BIN  bin/favicon.ico
Binary file not shown
View
350 bin/httpd
@@ -1,350 +0,0 @@
-#!/usr/local/bin/perl6
-use HTTP::Daemon;
-#defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();
-
-# Serve one page
-sub request( $c ) {
-# sub request {
- # 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; # 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"
- when / ^ '/' $ / { home( $c, $r ); }
- when / ^ '/dir/' $ / { directory( $c, $r ); }
- when / ^ '/proc/' $ / { processes( $c, $r ); }
- when / ^ '/browser/' $ / { browser( $c, $r ); }
- when / ^ '/svg/' $ / { svg( $c, $r ); }
- when / ^ '/svg/image01.svg' $ / { svg_image01( $c, $r ); }
- when / ^ '/favicon.ico' $ / { favicon( $c, $r ); }
- }
- }
- else {
- warn "{hhmm} rejected {$r.req_method} {$r.url.path}";
- $c.send_error('RC_FORBIDDEN');
- }
- warn ' '; # blank line
- }
-# }
-}
-
-# Executed as main parent process with an endless loop that re-starts
-# netcat after every page request.
-#sub daemon {
- my Str $host = %*ENV<LOCALADDR> // '127.0.0.1';
- my Int $port = int(%*ENV<LOCALPORT>) // 8888; #/ - p5 highlighting
- my HTTP::Daemon $d .= new( host=>$host, port=>$port );
- say "Browse this Perl 6 (Rakudo) web server at {$d.url}";
- $d.daemon();
-#}
-
-# Make a Home page for the / url
-sub home( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $html = qq[{page_top($c,$r)}<p/>
-
-Hello, Rakudo developers! You are visiting the first
-<a href="http://rakudo.org">Rakudo</a> based web server!
-I'm very young and small, and a bit slow, so please be gentle with me.
-<p/>
-
-My source code is in
-<a href="http://github.com/eric256/perl6-examples">perl6-examples</a>
-on
-<a href="http://github.com">GitHub</a>.<p/>
-
-All you need are the
-<a href="http://github.com/eric256/perl6-examples/tree/master/bin/httpd">bin/httpd</a>,
-<a href="http://github.com/eric256/perl6-examples/tree/master/lib/HTTP/Daemon.pm">lib/HTTP/Daemon.pm</a>
-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://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 );
-}
-
-# Show a listing of the current directory
-sub directory( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $html = qq[{page_top($c,$r)}
-<pre>
-{fake_qx('ls -l')}
-</pre>
-{page_bottom($c,$r)}];
- $c.send_response( $html );
-}
-
-# Show a list of all processes on the server computer
-sub processes( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $html = qq[{page_top($c,$r)}
-<pre>
-{fake_qx('ps -el')}
-</pre>
-{page_bottom($c,$r)}];
- $c.send_response( $html );
-}
-
-# Show the HTTP header lines received from the browser
-sub browser( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $html = qq[{page_top($c,$r)}<p/>
- This is what your browser sent to me in the HTTP header lines of its
- request:<p/>
- <table id="http_headers">\n];
- for $r.header_field_names -> Str $name {
- $html ~= qq[<tr><td class="browserinfo">$name</td>];
- $html ~= qq[<td class="browserinfo">{$r.header($name)}</td></tr>\n];
- }
- $html ~= qq[</table>\n{page_bottom($c,$r)}];
- $c.send_response( $html );
-}
-
-sub svg( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $html = qq[{page_top($c,$r)}<p/>
-Here is a resizeable example from the
-<a href="http://www.w3.org/TR/SVG11/">SVG 1.1 Specification</a>:<p/>
-
-<object type="image/svg+xml" data="/svg/image01.svg">
-(Alternate text for /svg/image01.svg)
-</object>
-<p/>
-If you see the alternate text and no SVG image, the web server was
-probably not ready in time to accept your request for the file.
-The image file alone is <a href="/svg/image01.svg">here</a>.
-{page_bottom($c,$r)}];
- $c.send_response( $html );
-}
-
-sub svg_image01( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $svg = qq[[<?xml version="1.0" encoding="UTF-8"?>
-<!-- example from http://www.w3.org/svg -->
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
- "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"
-[ <!ENTITY Smile "
-<rect x='.5' y='.5' width='29' height='39' fill='black' stroke='red'/>
-<g transform='translate(0, 5)'>
-<circle cx='15' cy='15' r='10' fill='yellow'/>
-<circle cx='12' cy='12' r='1.5' fill='black'/>
-<circle cx='17' cy='12' r='1.5' fill='black'/>
-<path d='M 10 19 A 8 8 0 0 0 20 19' stroke='black' stroke-width='2'/>
-</g>
-">
-<!ENTITY Viewport1 "<rect x='.5' y='.5' width='49' height='29'
-fill='none' stroke='blue'/>">
-<!ENTITY Viewport2 "<rect x='.5' y='.5' width='29' height='59'
-fill='none' stroke='blue'/>">
-]>
-<svg version="1.1" viewBox="0 0 450 300"
- xmlns="http://www.w3.org/2000/svg">
- <desc>Example PreserveAspectRatio - illustrates preserveAspectRatio attribute</desc>
- <rect x="1" y="1" width="448" height="298"
- fill="none" stroke="blue"/>
- <g font-size="9">
- <text x="10" y="30">SVG to fit</text>
- <g transform="translate(20,40)">&Smile;</g>
- <text x="10" y="110">Viewport 1</text>
- <g transform="translate(10,120)">&Viewport1;</g>
- <text x="10" y="180">Viewport 2</text>
- <g transform="translate(20,190)">&Viewport2;</g>
- <g id="meet-group-1" transform="translate(100, 60)">
- <text x="0" y="-30">--------------- meet ---------------</text>
- <g><text y="-10">xMin*</text>&Viewport1;
- <svg preserveAspectRatio="xMinYMin meet" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- <g transform="translate(70,0)"><text y="-10">xMid*</text>&Viewport1;
- <svg preserveAspectRatio="xMidYMid meet" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- <g transform="translate(0,70)"><text y="-10">xMax*</text>&Viewport1;
- <svg preserveAspectRatio="xMaxYMax meet" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- </g>
- <g id="meet-group-2" transform="translate(250, 60)">
- <text x="0" y="-30">---------- meet ----------</text>
- <g><text y="-10">*YMin</text>&Viewport2;
- <svg preserveAspectRatio="xMinYMin meet" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- <g transform="translate(50, 0)"><text y="-10">*YMid</text>&Viewport2;
- <svg preserveAspectRatio="xMidYMid meet" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- <g transform="translate(100, 0)"><text y="-10">*YMax</text>&Viewport2;
- <svg preserveAspectRatio="xMaxYMax meet" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- </g>
- <g id="slice-group-1" transform="translate(100, 220)">
- <text x="0" y="-30">---------- slice ----------</text>
- <g><text y="-10">xMin*</text>&Viewport2;
- <svg preserveAspectRatio="xMinYMin slice" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- <g transform="translate(50,0)"><text y="-10">xMid*</text>&Viewport2;
- <svg preserveAspectRatio="xMidYMid slice" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- <g transform="translate(100,0)"><text y="-10">xMax*</text>&Viewport2;
- <svg preserveAspectRatio="xMaxYMax slice" viewBox="0 0 30 40"
- width="30" height="60">&Smile;</svg></g>
- </g>
- <g id="slice-group-2" transform="translate(250, 220)">
- <text x="0" y="-30">--------------- slice ---------------</text>
- <g><text y="-10">*YMin</text>&Viewport1;
- <svg preserveAspectRatio="xMinYMin slice" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- <g transform="translate(70,0)"><text y="-10">*YMid</text>&Viewport1;
- <svg preserveAspectRatio="xMidYMid slice" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- <g transform="translate(140,0)"><text y="-10">*YMax</text>&Viewport1;
- <svg preserveAspectRatio="xMaxYMax slice" viewBox="0 0 30 40"
- width="50" height="30">&Smile;</svg></g>
- </g>
- </g>
-</svg>
-]];
- $c.send_response( $svg );
-}
-
-# Send the /favicon.ico file that almost every browser requests.
-# Create your own at http://www.degraeve.com/favicon/
-sub favicon( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- $c.send_file_response( 'favicon.ico' );
-}
-
-# Kind of template for the invariant part of the web page
-sub page_top( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- return qq[{start_html('Rakudo HTTP::Daemon '~$r.url.path)}
-<body>
-{banner}
-{nav_top($r)}
-];
-}
-
-# No need to have CGI.pm for one standard function
-sub start_html( Str $title ) {
- my $html = qq[<html><head><title>$title</title>
-{stylesheet}
-</head>];
- return $html;
-}
-
-# Web authors - your creativity goes here! http://www.csszengarden.com
-sub stylesheet {
-return q[<style type=text/css>
- h1 { font-family: helvetica, sans-serif;
- font-weight:bold; }
- table#nav_top { border-style: solid; width: 100%;
- text-align: center; }
- td.down { background-color: gray; }
- td.up { background-color: lightgray; }
- table#http_headers { border: solid black; }
- div#bottom { text-align: center; font-size: small;
- color: lightgray; }
- td.browserinfo { background-color: #f0f0f0;
- vertical-align: top; }
-</style>
-];
-}
-
-# Part of page_top, makes it easy to re-brand the site
-sub banner { return qq[<h1>Rakudo HTTP::Daemon web server</h1>\n];}
-
-# Simple menu for website main subdriectories
-sub nav_top( HTTP::Request $r ) {
- my @menu = (
- ['/', 'Home' ],
- ['/dir/', 'Directory'],
- ['/proc/', 'Processes'],
- ['/browser/', 'Browser' ],
- ['/svg/', 'SVG' ]
- );
- my Str $html = qq[<table id="nav_top">\n<tr>\n];
- for @menu -> $refitem {
- my $url = $refitem[0];
- my $name = $refitem[1];
- my $class = $url eq $r.url.path ?? 'up' !! 'down';
- $html ~= qq[<td class="$class"><a href="$url">$name</a></td>\n];
- }
- $html ~= qq[</table>\n];
-}
-
-# Kind of template for the invariant part of the web page
-sub page_bottom( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- return qq[<div id="bottom">Powered by Rakudo r{%*VM<config><revision>}</div>
-</body></html>];
-}
-
-# give the current time in hh:mm format
-sub hhmm {
- my $t = int(time);
- my $m = int( $t / 60 ) % 60;
- my $h = int( $t / 3600 ) % 24;
- my $hhmm = "{$h.fmt('%02d')}:{$m.fmt('%02d')}";
- return $hhmm;
-}
-
-# inefficient workaround - remove when Rakudo gets a qx operator
-sub fake_qx( $command ) {
- my $tempfile = "/tmp/rakudo_httpd_qx.tmp";
- my $fullcommand = "$command >$tempfile";
- run $fullcommand;
- my $result = slurp( $tempfile );
- unlink $tempfile;
- return $result;
-}
-
-=begin pod
-
-=head1 NAME
-httpd - HyperText Transfer Protocol Daemon or Perl 6 (Rakudo) web server
-
-=head1 SYNOPSIS
-
- git clone git://github.com/eric256/perl6-examples.git
- cd perl6-examples/lib/HTTP
- 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 such products. It must temporarily use the
-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.
-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
-programmer can concentrate on the web content, as this source code
-shows.
-
-=head1 INSTALLATION
-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 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. 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 or Parrot. The Rakudo of 2009-04-07 and Parrot r37973 were ok.
-
-=head1 SEE ALSO
-<doc:HTTP::Daemon>
-
-=head1 AUTHOR
-Martin Berends (mberends on CPAN github #perl6 and @autoexec.demon.nl).
-
-=end pod
View
2  lib/HTTP/Configure
@@ -1,2 +0,0 @@
-# Configure.p6 - installer - see documentation in ../Configure.pm
-use v6; BEGIN { @*INC.push( '..' ); }; use Configure;
View
385 lib/HTTP/Daemon.pm
@@ -1,385 +0,0 @@
-# This lib/HTTP/Daemon file contains definitions for HTTP::Daemon,
-# HTTP::Daemon::ClientConn, HTTP::Request and HTTP::Response.
-# Normally each class would be in a separate file, they were combined
-# here for convenience.
-
-# only a subset emulation of the Perl 5 HTTP::Headers design - no tuits!
-
-class HTTP::Headers {
- has %!header_values;
- method header( Str $fieldname ) {
- return %!header_values{ $fieldname };
- }
- method header_field_names {
- return %!header_values.keys;
- }
-}
-
-class HTTP::url {
- has $.path;
-}
-
-class HTTP::Request {
- has HTTP::Headers $!headers;
- has HTTP::url $!req_url;
- has Str $.uurl;
- has Str $.req_method is rw;
- has Str %.query is rw;
-
- method url {
- return $!req_url;
- }
- method header( Str $fieldname ) {
- return $!headers.header( $fieldname );
- }
- method header_field_names {
- return $!headers.header_field_names;
- }
-}
-
-class HTTP::Response {
-}
-
-sub urldecode($text) {
- state %hex;
- unless %hex {
- for 0..255 {
- my $h = $_.fmt('%02X');
- %hex{lc $h} = chr $_;
- %hex{uc $h} = chr $_;
- }
- }
- return $text.subst('+', ' ', :g).subst(/\%(<[0..9a..fA..F]>**{2})/, {%hex{$/[0]}}, :g);
-}
-
-# This maintains the connected TCP session and handles chunked data
-# transfer, but Rakudo and netcat end the session after every request.
-class HTTP::Daemon::ClientConn {
- has HTTP::Request $.request is rw;
- has Bool $!gave_request;
- has $.socket;
-
- method get_request {
- return unless defined $!gave_request;
- $!gave_request = Bool::True;
- my $buf = $.socket.recv();
- say $buf;
- my @lines = split("\x0D\x0A", $buf);
- my Str $line = @lines.shift();
- my @fields = $line.split(' ');
- # $*ERR.say: "-------------------";
- my Str $headerline;
- my %headers;
- repeat {
- $headerline = @lines.shift();
- # $*ERR.say: "HEADERLINE: $headerline";
- # if $headerline ~~ HTTP::headerline {
- # my $key = $/<key>;
- # my $value = $/<value>;
- # $*ERR.say: "MATCHED! KEY '$key' VALUE '$value'";
- # }
- # sorry, below isn't perlish, but above is broken
- my $index = $headerline.index(':');
- if $index {
- my $key = $headerline.substr( 0, $index );
- my $value = $headerline.substr( $index + 2 );
- %headers{$key} = $value;
- }
- } until $headerline eq ""; # blank line terminates
- # deal with body
- my %query;
- given %headers<Content-Type> // '' {
- when 'application/x-www-form-urlencoded' {
- my $body = @lines.join('');
- for $body.split(/<[&;]>/) -> $pair {
- $pair ~~ /$<name>=(.*)\=$<value>=(.*)/ or next;
- %query{urldecode($/<name>)} = urldecode($/<value>);
- }
- }
- when '' {
- # no content-type... not a problem
- }
- when * {
- warn 'unknown content-type in request';
- }
- }
- return HTTP::Request.new(
- req_url => HTTP::url.new( path=>@fields[1] ),
- headers => HTTP::Headers.new(
- header_values => %headers ),
- req_method => @fields[0],
- query => %query,
- );
- }
-
- method close {
- $.socket.close();
- }
-
- # the method servers should mainly use for normal page output
- method send_response( $self: Str $content ) {
- $self.send_basic_header;
- $self.send_crlf;
- $.socket.send($content);
- $.socket.close();
- }
-
- # provided for Perl 5 compatibility, send_response calls this
- method send_basic_header( $self: ) { $self.send_status_line; }
-
- # normally not called directly, send_basic_header calls this
- multi method send_status_line(
- Int $status? = 200,
- Str $message? = 'OK',
- Str $protocol? = 'HTTP/1.0'
- ) { $.socket.send("$protocol $status $message\n"); }
-
- # the internet newline is 0x0D 0x0A, "\n" would vary between OSes
- method send_crlf { $.socket.send("\x0D\x0A"); }
-
- # now tested with /favicon.ico
- method send_file_response( $self: Str $filename ) {
- $self.send_basic_header;
- $self.send_crlf;
- $self.send_file( $filename );
- }
-
- # now tested with /favicon.ico
- method send_file( Str $filename ) {
- my $contents = slurp( $filename );
- $.socket.send($contents);
- $.socket.close();
- }
-
- # not sure whether this and the next method might be inefficient
- multi method send_error( Int $status ) {
- my %message = (
- 200 => 'OK',
- 403 => 'RC_FORBIDDEN',
- 404 => 'RC_NOTFOUND',
- 500 => 'RC_INTERNALERROR',
- 501 => 'RC_NOTIMPLEMENTED'
- );
- self.send_error( $status, %message{$status} );
- }
-
- # seems inefficient
- 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 );
- }
-
- multi method send_error( Int $status, Str $message ) {
- self.send_status_line( $status, $message );
- self.send_crlf;
- $.socket.send("<title>$status $message</title>");
- $.socket.send("<h1>$status $message</h1>");
- $.socket.close();
- }
-
- method send_headers(*%headers) {
- for %headers.kv -> $k, $v {
- $.socket.send("$k: $v");
- self.send_crlf;
- }
- }
-}
-
-grammar HTTP::headerline {
- regex TOP { <key> ':' <.sp>* <value> }
- regex key { \S+ }
- regex value { .+ } # or should that be .* to allow an "empty" value?
-}
-
-class HTTP::Daemon
-{
- has Str $.host;
- has Int $.port;
- has Bool $!running;
- has Bool $!accepted;
-
- method daemon {
- $!running = Bool::True;
-
- # hack until we can get real CALLER support
- my %callerns := Q:PIR {{ $P0 = getinterp
- %r = $P0['namespace';1] }};
-
- my $listener = IO::Socket::INET.socket(2, 1, 6)\
- .bind($.host, $.port)\
- .listen();
- while $!running {
- my $work = $listener.accept();
- my HTTP::Daemon::ClientConn $c .= new( :socket($work) );
-
- # call request($c) in the caller's namespace
- %callerns<request>($c);
- }
- }
-
- # Where to find this server - used for messages, logs, hyperlinks
- method url { return "http://{$.host}:{$.port}/"; }
-
- # accept() waits for a browser connection and request and then
- # returns. Because netcat exits after a single receive + transmit,
- # this routine is different than the normal endless loop. It sets a
- # 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/socat cannot do HTTP 1.1 chunked transfer.
- method accept {
- return unless defined $!accepted;
- $!accepted = Bool::True;
- my HTTP::Daemon::ClientConn $clientconn .= new;
- return $clientconn;
- }
-}
-
-=begin pod
-
-=head1 NAME
-HTTP::Daemon - a (very) simple web server using Rakudo Perl 6
-
-=head1 SYNOPSIS
-
- git clone git://github.com/eric256/perl6-examples.git
- cd perl6-examples/lib/HTTP
- perl6 Configure
- make help
- make LOCALADDR=127.0.0.1 run
-
-=head1 DESCRIPTION
-You can make your own web server using L<doc:HTTP::Daemon> without using
-Apache, IIS or any kind of mod_perl. You control (almost) everything the
-web server does, let modules do the low level work and concentrate on
-functional design. If your site is fairly code intensive, this solution
-might be more efficient than sending all your data through another
-server process.
-
-Why bother when Apache is so popular? Think embedded web server, or
-maybe an application web front end, or web services. Custom stuff.
-
-This module shows how easily you can write a simple web server. Beware
-though, writing an advanced web server is hard and might result in
-Internet security breaches.
-
-=head1 EXAMPLES
-=head2 Small but working
-=begin code
-#!/usr/local/bin/perl6
-use HTTP::Daemon;
-defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();
-
-# handle a single browser request, executed in a child process of netcat
-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.req_method eq 'GET' {
- given $r.url.path {
- when '/' { root_dir( $c, $r ); }
- when / ^ \/pub\/ $ / { pub_dir( $c, $r ); }
- }
- }
- else {
- $c.send_error('RC_FORBIDDEN');
- }
- }
- }
-}
-
-# start the main server and enter the endless loop in the inner daemon.
-sub daemon {
- my HTTP::Daemon $d .= new( host=>'127.0.0.1', port=>2080 );
- say "Browse this Perl 6 web server at {$d.url}";
- $d.daemon();
-}
-
-# called from sub request for the '/' url
-sub root_dir( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $content = q[<html><head><title>Hello</title>
-<body><h1>Rakudo web server</h1>
-Hello, world! This is root. Go to <a href="/pub/">pub</a>.
-</body></html>];
- $c.send_response( $content );
-}
-
-# called from sub request for the '/pub/' url
-sub pub_dir( HTTP::Daemon::ClientConn $c, HTTP::Request $r ) {
- my $content = q[<html><head><title>Hello</title>
-<body><h1>Rakudo web server</h1>
-Hello again, this is pub. Go <a href="/">Home</a>.
-</body></html>];
- $c.send_response( $content );
-}
-=end code
-
-=head2 Perl 5 HTTP::Daemon example converted to Perl 6
-=begin code
-#!/usr/local/bin/perl6
-
-use v6;
-use HTTP::Daemon;
-defined @*ARGS[0] && @*ARGS[0] eq '--request' ?? request() !! daemon();
-
-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.req_method eq 'GET' and $r.url.path eq '/xyzzy' {
- # remember, this is *not* recommended practice :-)
- $c.send_file_response("/etc/passwd");
- }
- else {
- $c.send_error('RC_FORBIDDEN');
- }
- }
- }
-}
-
-sub daemon {
- my HTTP::Daemon $d .= new( host=>'127.0.0.1', port=>2080 );
- 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 -s -f /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 OSX:
-
- sudo port install socat
-
-=head1 BUGS
-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.
-
-HTTP 1.1 (L<http://www.ietf.org/rfc/rfc2616.txt>) describes all methods
-and status codes.
-
-=head1 AUTHOR
-Martin Berends (mberends on CPAN github #perl6 and @autoexec.demon.nl).
-
-=end pod
-
View
72 lib/HTTP/Makefile.in
@@ -1,72 +0,0 @@
-# Makefile.in for HTTP::Daemon
-#
-# Synopsis:
-# perl6 Makefile.p6 # morphs Makefile.in -> Makefile
-# make help # target summary
-# make all # precompile to Daemon.pir
-# make run # start httpd + HTTP::Daemon
-# make LOCAL_ADDR=192.168.1.100 run # run with other parrot
-#
-# Bugs:
-# This code may fail with certain revisions of Parrot and Rakudo.
-# All this software is being rapidly developed and frequently updated.
-# See #perl6 on irc.freenode.net for news/help.
-#
-
-all: precompile
-
-precompile: Daemon.pir
-
-clean:
- @find . -name '*.pir' -exec rm {} ';' # precompiled modules
- @find . -name '*~' -exec rm {} ';' # editor backups
-
-realclean: clean
- @rm Makefile
-
-run:
- export PERL6='$(PERL6)' PERL6LIB=$(PERL6LIB) LOCALADDR=$(LOCALADDR) LOCALPORT=$(LOCALPORT);\
- cd $(PERL6BIN); $(PERL6) httpd
-
-# Configuration variables:
-# Override one or more of these on the command line to adapt to local
-# parrot, rakudo and perl6-examples directories. Note these are make
-# variables, not shell variables.
-# eg: make PARROT_DIR=/my/parrot run
-PERL6 = <PERL6>
-PARROT_DIR = <PARROT_DIR>
-RAKUDO_DIR = <RAKUDO_DIR>
-PERL6LIB = <PERL6LIB>
-PERL6BIN = <PERL6BIN>
-LOCALADDR = 127.0.0.1
-LOCALPORT = 8888
-
-# define how to precompile a module from its source code
-.SUFFIXES: .pm .pir
-.pm.pir: $(PERL6)
- @echo 'precompile $< -> $@'
- @$(PERL6) --target=pir --output=$@ $<
-
-# List the targets to be made by users
-help:
- @echo ''
- @echo 'You can make the following targets:'
- @echo ''
- @echo 'all - default, precompile .pm to .pir for speed'
- @echo 'clean - removes .pir and backup~ files'
- @echo 'realclean - clean and also remove Makefile'
- @echo 'run - run httpd web server with or without precompile'
- @echo 'help - this text. See also: head --lines=14 Makefile.in'
- @echo ''
- @echo 'LOCALADDR: default 127.0.0.1'
- @echo ' Example: make LOCALADDR=192.168.1.123 run'
- @echo ''
- @echo 'LOCALPORT: default 8888, only root may use < 1024'
- @echo ' Example: make LOCALPORT=8080 LOCALADDR=192.168.1.123 run'
- @echo ''
- @echo 'There are two unusual aspects to his Makefile:'
- @echo '1. There is no "test" target yet, because that involves fetching web pages.'
- @echo '2. The "run" target deliberately does not depend on "all", so that you can'
- @echo ' "make clean run", edit Daemon.pm and refresh the browser page immediately.'
- @echo ' For quicker response times, "make all run" uses Daemon.pir instead.'
- @echo ''
Please sign in to comment.
Something went wrong with that request. Please try again.