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 ':80';

	$path = $ENV{'REQUEST_URI'};
	$path =~ s/\/[^\/]*$/\//;

	return redirect('http://' . $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;);
	print(&quot;Content-Type: text/html\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=iso-8859-1\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 ·