#!/usr/bin/perl
# yuno0.pl - Don Yang (uguu.org)
#
# ./yuno0.pl [port]
#
# 07/22/05
use strict;
use Socket;
use CGI ':standard';
my ($CHARSET, $MAXPOSTSIZE, $INTSIZE);
my ($Port, $Posts);
local (*SERVER, *CLIENT, *SERVER_PIPE, *CLIENT_PIPE);
$CHARSET = 'Shift_JIS';
$MAXPOSTSIZE = 0x20000;
$INTSIZE = length(pack 'I', 0);
# Send HTTP reply to client and exit child process
sub Reply()
{
my ($reply);
$reply = <<"EOT";
Yuno
$Posts
EOT
$reply =
"HTTP/1.0 200 OK\r\n" .
"Content-Type: text/html\r\n" .
"Server: Yuno\r\n" .
"Connection: close\r\n" .
"Content-Length: " . length($reply) . "\r\n\r\n" .
$reply;
send(CLIENT, $reply, 0);
close CLIENT;
close CLIENT_PIPE;
exit 0;
}
# Prepend post and send update to parent
sub AddPost($)
{
my ($post) = @_;
my ($query);
# Use CGI.pm to decode form encoded text
$query = new CGI($post);
$post = $query->param('x');
# Cook post data according to format
return if( $query->param('f') eq 'reload' );
$post =~ s/\r\n/\n/g;
if( $query->param('f') ne 'raw' )
{
$post =~ s/&/&/g;
$post =~ s//>/g;
if( $query->param('f') eq 'post' )
{
$post =~ s/\n/
/g;
}
else
{
$post = "\n$post
";
}
}
# Prepend post
$post .= '' . (scalar localtime);
$Posts = "\n
\n$post$Posts";
# Send post update to parent
$post = (pack 'I', length($post)) . $post;
print CLIENT_PIPE $post;
}
# Read post update from child
sub UpdatePosts()
{
my ($data, $entry, $size);
$entry = '';
if( read(SERVER_PIPE, $data, $INTSIZE, 0) )
{
$size = unpack 'I', $data;
while( read(SERVER_PIPE, $data, $size, 0) )
{
$entry .= $data;
$size -= length($data);
last if( $size <= 0 );
}
$Posts = "\n
\n$entry$Posts";
}
}
# Process HTTP request
sub ProcessRequest()
{
my ($request, $data, $headersize, $rsize);
# Read request until two newlines are seen
$request = '';
while( defined(recv(CLIENT, $data, 1024, 0)) )
{
$request .= $data;
if( ($headersize = index($request, "\r\n\r\n")) > 0 )
{
$headersize += 4;
last;
}
if( ($headersize = index($request, "\n\n")) > 0 )
{
$headersize += 2;
last;
}
}
# If this is a post request, read until all post data is read
if( $request =~ /^POST / )
{
$rsize = ($request =~ /content-length:\s*(\d+)/i) ? $1 : $MAXPOSTSIZE;
$rsize -= length($request) - $headersize;
while( $rsize > 0 && defined(recv(CLIENT, $data, $rsize, 0)) )
{
$request .= $data;
$rsize -= length($data);
}
print (('-' x 32), "\n", $request, "\n");
AddPost(substr($request, $headersize));
}
else
{
print (('-' x 32), "\n", $request, "\n");
}
Reply();
}
# Main server loop, never exits
sub Serve()
{
my ($rin, $rout);
# Create socket
unless( socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')) )
{
die "socket: $!\n";
}
unless( bind(SERVER, sockaddr_in($Port, INADDR_ANY)) )
{
die "bind: $!\n";
}
unless( listen(SERVER, 5) )
{
die "listen: $!\n";
}
unless( pipe SERVER_PIPE, CLIENT_PIPE )
{
die "pipe: $!\n";
}
binmode(SERVER);
binmode(SERVER_PIPE);
binmode(CLIENT_PIPE);
# Server loop
$rin = '';
vec($rin, fileno(SERVER), 1) = 1;
vec($rin, fileno(SERVER_PIPE), 1) = 1;
print "listening on $Port\n";
while( select($rout = $rin, undef, undef, undef) )
{
# Handle HTTP requests in child process
if( vec($rout, fileno(SERVER), 1) )
{
accept(CLIENT, SERVER);
if( fork )
{
close(CLIENT);
}
else
{
close(SERVER_PIPE);
binmode(CLIENT);
ProcessRequest();
}
}
# Handle post updates in current process
if( vec($rout, fileno(SERVER_PIPE), 1) )
{
UpdatePosts();
}
}
die "select: $!\n";
}
$Port = ($#ARGV >= 0 ? $ARGV[0] : 80);
$Posts = '';
Serve();