Edit this page

#!/usr/bin/perl

# Copyright (C) 2005 Jason Woofenden # # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This file is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with This file; see the file COPYING. If not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, # MA 02111-1307, USA.

use strict; use warnings;

use vars qw(%info %html); #this is how you define globals for this file (so it works under Registry) use vars qw($red %block_handlers %inline_handlers $image_url $FD $edit);

$red = 0;

sub import_post { my $i; my $key; my $val; my $buf; my @in;

%info = ();

if($ENV{'CONTENT_LENGTH'}) { $buf = ""; read(STDIN,$buf,$ENV{'CONTENT_LENGTH'}) || print "SOERUCHSERCUHSOERCUHSRECUH";

@in = split(/&/,$buf); #takes variable $in and cuts it into pieces seperated by (/&/ i guess) and puts the pieces into LIST @in

foreach $i (0 .. $#in) # loop through index numbers for @in list { # Convert plus's to spaces $in[$i] =~ tr/+/ /;

# Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

# Convert %XX from hex numbers to alphanumeric $key =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge;

$info{$key} = $val; #put values into associative array } } else { foreach $a (keys(%info)) { delete $info{$a}; } } }

sub redirect { my $addr = shift; print("Status: 302 Moved Temporarily\r\n"); print("Location: $addr\r\n\r\n"); print <EOF <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN"> <html><head> itle>302 Moved Temporarily</title> </head><body> <h1>302 Moved Temporarily</h1> <p>Please proceed to <a href=&quot;$addr&quot;>$addr</a>.</p> </body></html> EOF ; return 1; } sub wiki_redirect { my $addr = shift; my $path; my $port = ':' . $ENV{'SERVER_PORT'}; $port = '' if $port eq ':443'; $path = $ENV{'REQUEST_URI'}; $path =~ s/\/[^\/]*$/\//; return redirect('https://' . $ENV{'HTTP_HOST'} . $port . $path . $addr); } sub fix_mstring { my $name = shift; return unless(exists($info{$name})); # change windoze return chars into unix return chars $info{$name} =~ s/\015\012/\012/g; # change mac return chars into unix return chars $info{$name} =~ s/\015/\012/g; # take out any funky symbols #$info{$name} =~ s/[^a-zA-Z0-9\012\011 ~`!@#\$\%^&amp;*(){}[\]\\|_&quot;'<,>.?+=\/:;-]//g; } sub esc_atr { $_ = shift; s/\&amp;/\&amp;amp;/g; s/\&quot;/\&amp;quot;/g; return $_; } sub esc_html { $_ = shift; s/\&amp;/\&amp;amp;/g; s/\&quot;/\&amp;quot;/g; s/\</\&amp;lt;/g; s/\>/\&amp;gt;/g; return $_; } sub wiki_link_encode { my $url = shift; # translate windoze return chars $url =~ s/\015\012/_/g; # translate mac return chars $url =~ s/\015/_/g; # translate unix return chars $url =~ s/\012/_/g; $url =~ tr/' -/___/s; $url =~ tr/A-Z/a-z/; $url =~ s/[^a-zA-Z0-9._]//g; $url =~ s/^\.+//g; return $url; } sub url_encode { my $url = $_[0]; $url =~ s/([^\w.\/])/&quot;%&quot; . sprintf(&quot;%2.2X&quot;,ord($1))/eg; return $url; } sub _textarea { return '<textarea name=&quot;'. $_[0] .'&quot; rows=&quot;30&quot; cols=&quot;80&quot;>'. esc_html($info{$_[0]}) .'</textarea>'; } sub fill_template { my $name = shift; if(exists($html{$name})) { return $html{$name}; } else { return &quot;~$name~&quot;; } } #################################################################### ######################## GENERATE HTML ########################### #################################################################### sub key { my $a; read($FD, $a, 1) or $a = &quot;&quot;; return $a; } sub next_not_space_or_tab { my $a; do { $a = key(); } while $a =~ /[^\S\n]/; return $a; } sub next_non_whitespace { my $a; do { $a = key(); } while $a =~ /\s/; return $a; } sub html_esc_char { my $c = shift; my %entities = ( '&amp;' => '&amp;amp;', '>' => '&amp;gt;', '<' => '&amp;lt;', '&quot;' => '&amp;quot;'); return $entities{$c} if exists($entities{$c}); return $c; } sub bad_code { return &quot;<strong class=\&quot;error\&quot;>\&amp;lt;$_[0]</strong>&quot;; } sub parse_blocks { my $ret; my $a; $ret = ''; while (1) { $a = next_non_whitespace(); if($a eq '') { return $ret; } if($a eq '<') { $a = key(); if($a eq '>' or $a eq '') { return $ret; } elsif(exists($block_handlers{$a})) { $ret .= &amp;{$block_handlers{$a}}(); next; } elsif(exists($inline_handlers{$a})) { $a = &amp;{$inline_handlers{$a}}(); } else { $a = bad_code($a); } } $ret .= '<p>' . $a . parse_line() . &quot;</p>\n\n&quot;; } } # read to end tag or \n\n # parsing inline tags along the way # pass true if you want it to eat line breaks before parsing sub parse_line { my $ret; my $a; my $last; $last = ''; $a = shift; if($a) { $a = next_non_whitespace(); } else { $a = key(); } $ret = &quot;&quot;; while(1) { if($a eq &quot;&quot;) { return $ret; } if($a eq &quot;<&quot;) { $a = key(); if(exists($inline_handlers{$a})) { $a = &amp;{$inline_handlers{$a}}(); } elsif( $a eq '>' ) { return $ret; } else { $a = bad_code($a); } } elsif($a eq &quot;\n&quot; and $last eq &quot;\n&quot;) { chop $ret; return $ret; } else { $a = html_esc_char($a); } $ret .= $a; $last = $a; $a = key(); } } # read up to 100 chars from the first line sub parse_title { my $ret = &quot;&quot;; my $a; while(1) { $a = key(); if($a eq &quot;\012&quot; or $a eq &quot;\015&quot; or $a eq '') { return $ret; } $ret .= html_esc_char($a); if(length($ret) > 99) { return $ret; } } } # read to end tag # parse only < # escape html entities sub pre { my $ret; my $a; while(1) { $a = key(); if($a eq &quot;&quot;) { return $ret; } if($a eq '<') { $a = key(); if($a eq '>') { return $ret; } elsif($a ne '<') { $a = '<' . $a; } } $ret .= $a; } } sub handle_open { return '&amp;lt;'; } sub handle_headline { return '<h2>' . parse_line() . &quot;</h2>\n\n&quot;; } sub handle_subhead { return '<h3>' . parse_line() . &quot;</h3>\n\n&quot;; } sub handle_hr { return '<hr />'; } sub handle_code { return '<code>' . parse_line() . '</code>'; } sub handle_em { return '<strong>' . parse_line() . '</strong>'; } sub handle_pre { return '<pre>' . esc_html(pre()) . &quot;</pre>\n\n&quot;; } sub handle_link { my $addr; $addr = pre(); if($addr =~ /:/) { return '<a href=&quot;' . esc_atr($addr) . '&quot;>' . esc_html($addr) . '</a>'; } if($addr =~ /edit this page/i) { return '<a href=&quot;' . $html{page_name} . '?edit&quot;>' . esc_html($addr) . '</a>'; } return '<a href=&quot;' . wiki_link_encode($addr) . '&quot;>' . esc_html($addr) . '</a>'; } sub _handle_image { my $addr = shift; my $alt; $alt = esc_atr($addr); # if linking to a local image, prepend the images folder path if($addr !~ /:/) { $addr = $image_url . url_encode($addr); } return &quot;<img src=\&quot;$addr\&quot; alt=\&quot;$alt\&quot;>&quot;; } sub handle_image { my $addr = esc_atr(pre()); return _handle_image($addr); } sub handle_image_block { return &quot;<div class=\&quot;img_float\&quot;>&quot; . handle_image() . &quot;</div>&quot; . parse_line() . &quot;<div style=\&quot;clear: left\&quot;></div>&quot;; } sub handle_thumb{ my $taddr; my $addr; my $alt; my @parts; my $tmp; $addr = esc_atr(pre()); @parts = split(/\./, $addr); $taddr = pop @parts; $tmp = pop @parts; $tmp .= '_thumb'; push(@parts, $tmp); push(@parts, $taddr); $taddr = join('.', @parts); $alt = esc_atr($addr); # if linking to a local image, prepend the images folder path if($addr !~ /:/) { $addr = $image_url . url_encode($addr); } return &quot;<a href=\&quot;$addr\&quot;>&quot; . _handle_image($taddr) . &quot;</a>&quot;; } sub handle_thumb_block { return &quot;<div class=\&quot;img_float\&quot;>&quot; . handle_thumb() . &quot;</div>&quot; . parse_line() . &quot;<div style=\&quot;clear: left\&quot;></div>&quot;; } sub handle_bullet_list { my $a; my $ret = &quot;<ul>\n&quot;; while(1) { $a = next_non_whitespace(); if($a eq '') { return $ret . &quot;</ul>\n\n&quot;; } if($a eq '<') { $a = key(); if($a eq '>' or $a eq '') { return $ret . &quot;</ul>\n\n&quot;; } elsif(exists($block_handlers{$a})) { if($a eq '*') { # FIXME FIXME FIXME FIXME FIXME FIXME $ret .= &amp;{$block_handlers{$a}}(); } else { $ret .= &quot;<li>\n\n&quot; . &amp;{$block_handlers{$a}}() . &quot;\n</li>\n&quot;; } next; } elsif(exists($inline_handlers{$a})) { $a = &amp;{$inline_handlers{$a}}(); } else { $a = bad_code($a); } } $ret .= '<li>' . $a . parse_line() . &quot;</li>\n&quot;; } } sub handle_cf_define { $red = 1; return '<code class=&quot;s&quot;>: </code><code class=&quot;d&quot;>' . parse_line() . '</code>'; } sub handle_cf_execute { $red = 0; return '<code class=&quot;s&quot;>[ </code><code class=&quot;e&quot;>' . parse_line() . '</code>'; } sub handle_cf_compile { my $ret = ''; if($red != 1) { $ret = '<code class=&quot;s&quot;>] </code>'; } $red = 0; return $ret . '<code class=&quot;c&quot;>' . parse_line() . '</code>'; } sub handle_cf_constant { $red = 0; return '<code class=&quot;s&quot;>\' </code><code class=&quot;o&quot;>' . parse_line() . '</code>'; } sub handle_cf_tic { $red = 0; return '<code class=&quot;s&quot;>` </code><code class=&quot;t&quot;>' . parse_line() . '</code>'; } %inline_handlers = ( '<' => \&amp;handle_open, 'c' => \&amp;handle_code, 'e' => \&amp;handle_em, 'l' => \&amp;handle_link, 'i' => \&amp;handle_image, 't' => \&amp;handle_thumb, ':' => \&amp;handle_cf_define, '[' => \&amp;handle_cf_execute, ']' => \&amp;handle_cf_compile, &quot;'&quot; => \&amp;handle_cf_constant, '`' => \&amp;handle_cf_tic); %block_handlers = ( 'H' => \&amp;handle_headline, 'h' => \&amp;handle_subhead, 'r' => \&amp;handle_hr, 'p' => \&amp;handle_pre, '*' => \&amp;handle_bullet_list, 'i' => \&amp;handle_image_block, 't' => \&amp;handle_thumb_block); # return true if it looks like this request came from a bot sub is_bot { return $info{'page'} =~ /Content-Type: multipart\/alternative/; } sub handler { my $host; if(!exists($ENV{'HTTP_HOST'})) { $ENV{'HTTP_HOST'} = $ENV{'SERVER_ADDR'}; } %info = (); %html = (); my $template_filename; my $title; $image_url = 'images/'; my $data_dir = $ENV{'SCRIPT_FILENAME'}; $data_dir =~ s/\/[^\/]*$/\/pages/; import_post(); fix_mstring 'page'; $html{'message'} = ''; $a = $ENV{'REQUEST_URI'}; if($a =~ /\?edit$/) { $edit = 1; } else { $edit = 0; } $a =~ s/.*\///; $a =~ s/\?.*$//; $a = wiki_link_encode($a); if($a eq '') { $a = 'home'; } $html{'page_name'} = $a; $html{'host'} = $ENV{'HTTP_HOST'}; $html{'host'} =~ s/:.*//; if($html{'page_name'} eq 'home') { $html{'page_filename'} = &quot;$data_dir/$html{host}&quot;; } else { $html{'page_filename'} = &quot;$data_dir/$a&quot;; } if(exists($info{'page'})) { # if this is a request from that stupid spam bot, then store the data elsewhere if(is_bot()) { $html{'page_filename'} = &quot;$data_dir/damn_robots&quot;; $a = open FD, &quot;>>$data_dir/robot_log&quot;; print FD time(); print FD ' '; print FD %ENV; print FD &quot;\n\n&quot;; close(FD); } $info{'robot'} =~ s/[,. ]//g; if($info{'robot'} =~ '^[0-9][0-9][0-9][0-9]$') { $a = open FD, &quot;>$html{page_filename}&quot;; if($a) { print FD $info{'page'}; close(FD); $html{'message'} = '<p>Page saved successfuly.</p>'; # After recieving a post to change one of the pages, we # redirect to that page (so that browsers' back button will # work without having to resend the POST.) # Unless they're using lynx, which isn't stupid enough to # resubmit a POST when you hit &quot;back&quot;. (This is also important # because when you send Lynx a redirect in response to a POST # it sends a POST to the url you redirect it to. This doesn't # work here.) # a meta-refresh style redirect might work well here, not sure. if($ENV{HTTP_USER_AGENT} !~ /Lynx/) { $a = $html{'page_name'}; %html = (); # save memory %info = (); # save memory return wiki_redirect($a); } } else { $html{'message'} = &quot;<strong class=\&quot;err\&quot;>Could't open file \&quot;$html{page_filename}\&quot; for writing.</strong>&quot;; } } else { $html{'message'} = &quot;<strong class=\&quot;err\&quot;>ERROR: Not saved. The anti-robot field was not filled properly.</strong>&quot;; } } $a = open FUD, &quot;<$html{page_filename}&quot;; if(!$a) { $html{'message'} = &quot;<p>This page doesn't exist yet. Create one below if you like</p>&quot;; $info{'page'} = ''; $html{'page'} = _textarea 'page'; $edit = 1; } else { if($edit) { read FUD, $info{'page'}, 20000; $html{'page'} = _textarea 'page'; } else { $FD = *FUD; $html{'title'} = parse_title(); $html{'page'} = parse_blocks(); $FD = 0; close(FUD); } } #################################################################### ######################## FILL TEMPLATE ########################### #################################################################### print(&quot;Status: 200 OK\r\n&quot;); $a = `date '+%a, %d %b %Y %H:%M:%S %z'`; chop($a); print(&quot;Last-Modified: $a\r\n&quot;); # always modified print(&quot;Expires: Mon, 26 Jul 1997 05:00:00 GMT\r\n&quot;); # Date in the past print(&quot;Cache-Control: no-cache, must-revalidate\r\n&quot;); # HTTP/1.1 print(&quot;Pragma: no-cache\r\n&quot;); # HTTP/1.0 print(&quot;Content-Type: text/html; charset=utf-8\r\n\r\n&quot;); #foreach $a (keys(%info)) { # print &quot;$a: &quot; . $info{$a} . &quot;<br />\n&quot;; #} #if(0) { # foreach $a (keys(%ENV)) { # print &quot;$a: &quot; . $ENV{$a} . &quot;<br />\n&quot;; # } #} $html{''} = '~'; if($edit) { if(stat(&quot;$data_dir/$html{host}_edit_template.html&quot;)) { $template_filename = &quot;$data_dir/$html{host}_edit_template.html&quot;; } else { $template_filename = &quot;$data_dir/edit_template.html&quot;; } } else { if(stat(&quot;$data_dir/$html{host}_template.html&quot;)) { $template_filename = &quot;$data_dir/$html{host}_template.html&quot;; } else { $template_filename = &quot;$data_dir/template_thumb.html&quot;; } } open(FD, &quot;<$template_filename&quot;) || print &quot;Error: couldn't open \&quot;$template_filename\&quot;<br>\n&quot;; read(FD, $a, 2048); $a =~ s/~([^~]*)~/fill_template(&quot;$1&quot;)/ge; print $a; close FD; %html = (); # save memory %info = (); # save memory $a = ''; # save memory return 1; } handler();

Edit this page · home ·