Permalink
Browse files

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

  • Loading branch information...
1 parent 8f364e6 commit 576f6152cb174461677942cba983c634ed9b8501 @mberends mberends committed Dec 8, 2009
Showing with 0 additions and 809 deletions.
  1. BIN bin/favicon.ico
  2. +0 −350 bin/httpd
  3. +0 −2 lib/HTTP/Configure
  4. +0 −385 lib/HTTP/Daemon.pm
  5. +0 −72 lib/HTTP/Makefile.in
View
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
@@ -1,2 +0,0 @@
-# Configure.p6 - installer - see documentation in ../Configure.pm
-use v6; BEGIN { @*INC.push( '..' ); }; use Configure;
Oops, something went wrong.

0 comments on commit 576f615

Please sign in to comment.