[initial import Ganesh Sittampalam **20130129135755 Ignore-this: d54c20121b0e54ce1eb13d4abbcf780e ] addfile ./done.thtml hunk ./done.thtml 1 + + + +Done + +

Entry added!

+ + addfile ./error.thtml hunk ./error.thtml 1 + + + +Error + +

Sorry, the following error occured:

$errmsg

Please contact ganesh@earth.li

+ + addfile ./newentry.thtml hunk ./newentry.thtml 1 + + + +Add a new entry to the psychopath status watcher + + +

Feel free not to give your email address, though a name would be +appreciated. The script will log the host you are connecting from and +display that on the status page too.

+ + + addfile ./psychopath.pl hunk ./psychopath.pl 1 +#!/usr/bin/perl -wT + +$safeperl = 0; + +$scripturl = 'psychopath.pl'; + +$datafile = 'psychopathdata'; +$datadir = '/home/ganesh/psychopath'; + +$donefile = 'done.thtml'; +$newentryfile = 'newentry.thtml'; +$errorfile = 'error.thtml'; +$viewfile = 'view.thtml'; + +@entries = ('name','email','text', 'road'); + +$notify = 'psychopath@lists.urchin.earth.li'; +# $notify = 'ganesh@earth.li'; + +$admin = 'ganesh@earth.li'; +$from = 'Marston Psychopath Status Update '; + +# --- For non-safeperl --- # + +use Carp; + +sub sort_numeric { sort {$a <=> $b} @_ } + +$ENV{'PATH'} = ''; + +sub mail { + croak 'Usage: mail($recipient, $subject, $contents)' unless @_ == 3; + my ($recipient, $subject, $contents) = @_; + croak 'Undefined recipient' unless defined $recipient; + croak 'Undefined subject' unless defined $subject; + croak 'Undefined contents' unless defined $contents; + local(*MAILHANDLE); + # Sanity checks + return 0 unless length($recipient) < 256 + && $recipient =~ /^[A-Za-z0-9][A-Za-z0-9.@%:$&_+=~-]+$/ + && length($subject) <= 256; + # Mild attempt to avoid people sending local email by mistake + return 0 if $recipient !~ /@/; + $subject =~ tr/\n\r\f//d; + my $pid = open(MAILHANDLE, "|-"); + return 0 unless defined($pid); + if (!$pid) { + # child + # Avoid calling "exit" on failure since it no longer does a real + # exit and instead returns to perl in the child with a "Callback + # called exit" error message followed by double flushing of + # input buffers + exec("/usr/bin/mail", "-s $subject", + '-a', "From: $from", $recipient) + or exec("/bin/false") or die "panic: can't even exec /bin/false\n"; + } + # parent + print MAILHANDLE $contents; + close MAILHANDLE; + return !($? >> 8); +} + + + +# --- Hopefully you shouldn't need to change anything below this line --- # + +$datainput = $datadir.'/'.$datafile; +$dataoutput = $safeperl ? $datafile : $datainput; + +print "Content-type: text/html\n\n"; + +sub linksub { + ($var,$string,$queryhash,$form)=@_; + if($form) { + $formstart=''; + $$var=~s/\(.*?)\<\/A\>/$formstart$1$formend/sig; + } else { + $query=""; + foreach $key (keys %$queryhash) { + $query.="$key=$$queryhash{$key}&"; + } + chop $query; + $query=~s/&/&/g; + $$var=~s/\//sig; + } +} + +sub formsub { + ($var,$string,$replace)=@_; + $$var=~s/\//sig; +} + +sub slurp { + my ($filename)=@_; + open FILE,"<$datadir/$filename" + or cgierror("Couldn't open $filename"); + my $data=""; + while() { + $data.=$_; + } + close FILE; + linksub(\$data,"NEWENTRY",{"mode" => "newentry"},0); + linksub(\$data,"VIEW",{"mode" => "view"},0); + formsub(\$data,"ACTIONSELF",'ACTION="'.$scripturl.'"'); + return $data; +} + +$handlingerror=0; + +sub cgierror { + my ($error)=@_; + if($handlingerror) { + print "Fatal error!\n"; + print "

"; + print $error; + print "

"; + print "Please email $admin " + ."explaining how you got this error"; + print "\n"; + } + $handlingerror=1; + + $errordata=slurp($errorfile); + + $errordata=~s/\$errmsg/$error/ig; + + print $errordata; + + exit; +} + +sub escape { + my $data=shift; + $data=~s/&/&/g; + $data=~s//>/g; + # not sure if these improve the look or not, on balance probably not + # $data=~s/\n/
/g; + # $data=~s/\\n/
/g; + return $data; +} + +if(uc($ENV{'REQUEST_METHOD'}) eq "GET") { + $input=$ENV{'QUERY_STRING'}; +} elsif(uc($ENV{'REQUEST_METHOD'}) eq "POST") { + read(STDIN,$input,$ENV{'CONTENT_LENGTH'}); +} + +@kvpairs = split (/&/, $input); + +foreach $kvpair (@kvpairs) { + ($key,$value) = split (/=/, $kvpair); + $value =~ tr /+/ /; + $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg; + $kvpairs{$key} = $value; +} + +defined($kvpairs{'mode'}) or $kvpairs{'mode'}='view'; + +if($kvpairs{'mode'} eq 'add') { + + foreach $entry (@entries) { + defined($kvpairs{$entry}) or cgierror("You need a $entry parameter"); + } + + $kvpairs{'road'} = lc($kvpairs{'road'}); + $kvpairs{'road'} =~ s/\s//g; + + $kvpairs{'road'} eq 'motorway' or cgierror("You got the road wrong"); + + $remote="$ENV{'REMOTE_ADDR'} ($ENV{'REMOTE_HOST'})"; + + mail($notify,"Psychopath update", + "Author: $kvpairs{'name'} ($kvpairs{'email'}) from $remote\n". + "Information: \n$kvpairs{'text'}\n"); + + open DATA, ">>$dataoutput" + or cgierror("Couldn't open submissions file for writing"); + + print DATA time; + print DATA "\n"; + + foreach $entry (@entries) { + $kvpairs{$entry}=~s/\n/\\n/g; + chomp($kvpairs{$entry}); + print DATA $entry.'='.$kvpairs{$entry}."\n"; + } + + print DATA "remote=$remote\n"; + print DATA "--\n"; + + close DATA; + + print slurp($donefile); + +} elsif($kvpairs{"mode"} eq "view") { + + $template=slurp($viewfile); + + open DATAI,"$datainput" + or cgierror("Couldn't open data file for reading"); + + until(eof DATAI) { + $time=; + chomp $time; + + my $lastkey; + + do { + $input=; + # handle continuation lines which seem to appear with a literal \n + if ($input =~ /^\\n(.*)$/) { $data{$time}->{$lastkey}.="\n$1"; } + if ($input=~/^(\w+)=(.*)$/) { $data{$time}->{$1}=$2; $lastkey=$1; } + } while($input!~/^--$/); + } + + close DATAI; + + $page=defined($kvpairs{"page"}) ? $kvpairs{"page"} : 1; + + ($max)= + ($template=~/\/i) + or cgierror("Need MAX specifier in REPEAT tag in template file"); + + $startnum=$max*($page-1); + $endnum=$max*($page)-1; + + $maxnum=(scalar keys %data)-1; + + $endnum>$maxnum and $endnum=$maxnum; + + if($startnum==0) { + $template=~s/\.*?\<\/IFNEXT\>//sig; + } else { + $template=~s/\(.*?)\<\/IFNEXT\>/$1/sig; + linksub(\$template,"NEXT", + {"mode" => $kvpairs{"mode"}, + "page" => $page-1}, + 0); + } + + if($endnum==$maxnum) { + $template=~s/\.*?\<\/IFPREV\>//sig; + } else { + $template=~s/\(.*?)\<\/IFPREV\>/$1/sig; + linksub(\$template,"PREV", + {"mode" => $kvpairs{"mode"}, + "page" => $page+1}, + 0); + } + + ($pre,$repeat,$post)= + ($template=~/^(.*)\(.*)\<\/REPEAT\>(.*)$/si) + or cgierror("Bad template file format"); + + + print $pre; + + foreach $time ((reverse (sort_numeric (keys %data)))[$startnum..$endnum]) { + ($min,$hour,$day,$mon,$year,$wday) = (localtime($time))[1,2,3,4,5,6]; + @months = ("January","February","March","April","May","June", + "July","August","September","October","November","December"); + @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday', + 'Friday','Saturday'); + + $datestr="$days[$wday] $day $months[$mon] ".($year+1900) + ." ".($hour<10 ? "0$hour" : $hour).":" + .($min<10 ? "0$min" : $min)."\n"; + $out=$repeat; + + $data{$time}->{'email'}=~/([\d\w\._\-\+\%]+@[\d\w\._\-\+\%]+)/ + or $data{$time}->{'email'}=''; + + foreach $entry (@entries,'remote') { + $out=~s/\$$entry/escape($data{$time}->{$entry})/ieg; + } + $out=~s/\$date/$datestr/ig; + + print $out; + } + + print $post; + +} elsif($kvpairs{"mode"} eq "newentry") { + print slurp($newentryfile); +} else { + cgierror("Unknown mode!"); +} addfile ./view.thtml hunk ./view.thtml 1 + + + +Marston Psychopath status information + + +

Marston Cycle Path flooding information

+ +

Updates to this page get sent out by email too; to receive them +subscribe to the mailman list psychopath@lists.urchin.earth.li +by visiting +this page. + +

You may also find the current flag status of the river useful. This page tracks the level of the Isis at Friar's Wharf; Geraint Jones informs me +that 15" to 20" above normal there seems to be a good match for a flooded path.

+ +

The Environment Agency has an automated level meter at the Southern end of Mesopotamia with two readings available: +upstream +and +downstream. +Once calibrated against the flooding of the path these should provide a useful warning mechanism. +

+ + +

+Add a new entry +

+Previous 10 entries +Next 10 entries +

+ +

+$date: $name ($email) from $remote said: +
+$text

+ +

+Previous 10 entries +Next 10 entries +

+ +

“ +An A-road walks into a bar and asks for a pint. The barman serves +him, but he looks really tough and the barman worries that there'll be +trouble. +

+ +

“ +Then a dual carriage way walks in and buys a pint. The barman again notes +that he looks tough and says, ‘Look, I don't want any trouble, so could +you sit in that corner away from the A-road?’ So the dual carriage way +does. +

+ +

“ +Soon afterwards, in walks a motorway and gets a pint, who looks extremely +tough, so the barman makes him sit in another corner away from the other +two roads. +

+ +

“ +A bit later, a really small road walks in and buys a diet coke. The +A-road, dual carriage way and motorway all look at him aghast and run out +of the pub. The barman grabs the motorway on the way past and asks, ‘Why +are you running out? He's a really tiny road.’ +

+ +

“ +The motorway replies, ‘He's no road, he's a cycle path!’ +”

+ +

(supplied by +Ændr)

+ +

+Web page(s) maintained by +Ganesh Sittampalam +
+Templates etc last updated 24/11/12 (reports are updated as people submit new ones) +

+ + + +