#!/usr/bin/perl -T use warnings; use strict; BEGIN { use IO::Handle; open our $LOG, ">", "/home/student/ambrus/a/html/.fly.log" or die "cannot write error log"; sub tolog { chomp(my $s = join("", @_)); warn "logged: " . $s; print $LOG "fly " . localtime() . ": " . $s . "\n" or die "cannot write error log"; flush $LOG; } tolog "starting"; $SIG{__WARN__} = \&tolog; our $OLDSIGDIE = $SIG{__DIE__}; $SIG{__DIE__} = \&tolog; } CHECK { #$SIG{__DIE__} = our $OLDSIGDIE; tolog "checking"; } END { tolog "ending"; } eval { use lib "/home/student/ambrus/local/perl/lib/perl/5.8.4"; use Coro; use Coro::Handle; use Coro::Timer; use Coro::Socket; use Socket; print qq{Content-Type: text/html; charset=ISO-8859-2\n\n}; my @jobs; push @jobs, async { tolog "[D10]"; select unblock *STDOUT; print qq{ On-the-fly server experiment

On-the-fly server experiment

This CGI script experiments with starting a TCP server connection on the fly to serve an image embedded in the page. I do not recommend this technique for production.

So, here's an image: }; socket my $S, PF_INET(), SOCK_STREAM(), 0 or die "socket $!"; listen $S, 1 or die "listen $!"; my($p, undef) = sockaddr_in(getsockname $S); push @jobs, async { eval { my $Su = Coro::Socket->new_from_fh($S); my $A = $Su->accept or die "accept: $!"; open my $I, "<", "/home/student/ambrus/a/html/pu/egyetem.jpg" or die "open image: $!"; print $A "HTTP/1.1 200 Ok\nContent-type: image/jpeg\n" . "Content-length: " . (-s $I) . "\n\n" or die "print image header: $!"; while (read $I, my $b, 4*1024) { print $A $b; #Coro::Timer::sleep 0.1; } close $A; }; $@ and warn($@), die($@); }; my $sn = $ENV{"SERVER_NAME"} || "localhost"; print q{

Now I'll print some lines just to see if the image data and the webpage can be loaded async. }; for my $i (1 .. 10) { Coro::Timer::sleep 2; print q{

Just a line } . $i . qq{, nothing more.\n}; } print q{

Goodbye for now. }; }; tolog "[D20]"; $_->join for @jobs; }; $@ and do { tolog $@; }; __END__