#!/usr/bin/perl ################################################################################ # # # fsweblog 0.9.9.2 http://swoolley.org/blog.cgi?get=src # # # # Copyright (c) 2003/4/5/6/7/8 Seth Alan Woolley, under the GNU GPL >= v.3 # # See http://www.fsf.org/licenses/gpl.txt for a copy of the license. # # # ################################################################################ # configuration variables $hometitle = "Seth Woolley's Blog"; # required per RSS spec. $homedescr = "Occasional Musings"; # required per RSS spec. $homeicbm = "45.5438, -122.6295"; # ICBM address, geourl.org $homeTZ = "-08:00"; # for RSS timezone spec. (-08:00 is PST) $homelang = "en-US"; # for RSS language spec. $homecss = "$ENV{SCRIPT_NAME}?get=css"; # change to use non-builtin CSS $homecss = "/man.cgi/c=1"; # non-builtin CSS $turing = "fsweblog"; # turing test for commenters if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) { $contenttype= "text/html"; # xhtml 1.1 isn't "truly" supported in MSIE } else { $contenttype= "application/xhtml+xml";# xhtml 1.1 validation requires this } # or edit the CSS below. $relpath = "blog/"; # relative path to paths below (from here) $datadir = $relpath . "blogs"; # relative to the script for blogs. $commentdir = $relpath . "comments"; # relative to the script for comments. $categorydir= $relpath . "categories";# relative to the script for categories. $noquery = 1; # 1 if PATH_INFO, undef for QUERY_STRING $line = 70; # when to wrap text $dotplan = $relpath . "plan/plan";# point ~/.plan to here via symlink # (or undef to disable) $webroot = "/var/www/"; # needed for dotplan support $refsfile = "referindex.tab"; # referrers file, relative to docroot $blogstart = 1; # start number of blogs to display $rdfstart = 1; # start number of blogs to display w/RDF $blogmax = 10; # maximum number of blogs to display $rdfmax = 10; # maximum number of blogs to display w/RDF # latest blog image: ?get=jpeg or ?get=png @bg = (000,000,000); # background color of image, RGB, 0-255 @fg = (255,255,255); # foreground color of image, RGB, 0-255 $tp = undef; # transparent bg of image? make 1 or undef # installation instructions # # Copy this file into a directory on your server with all execute permissions. # Make sure to rename it "index.cgi" without ?get=src at the end (no quotes). # Execute permissions are a+x, 755, or all with execute, and can be setup in # your ftp program or by using the chmod unix utility: chmod 755 index.cgi # # Make a directory in the same directory as this file called $datadir # ("blogs", by default). Set its permissions to 755 as well (the same as # the script). This is where you upload or write your blogs directly to. # The blogs are simply text files with the name set to the subject you want. # Use the unix commands: mkdir blogs; chmod 755 blogs # # Make another directory in the same directory as this file called $commentdir # ("comments", by default). Set its permissions to 775, a+xg+w, or all # with execute and group with write in addition to its normal permissions. # Change its group to the webserver group, typically apache, nogroup, or httpd. # Use the commands: mkdir comments; chmod 775 comments; chgrp nogroup comments # # If you want to not enable comments, set the comments permissions to 755 # instead of 775. Then to enable comments on a blog-by-blog basis, create # a directory the same name as the blog you created with 775 permissions, # with a group of nogroup (or whatever your web server group is). # Commands: mkdir comments; chmod 755 comments; chgrp nogroup comments; # mkdir comments/blogtitle; chmod 775 comments/*; chgrp nogroup comments/* # Repeat the second line of commands above when you create a new # commentable blog. # # Security note: Anybody with permissions to the webserver group can then # edit the comments on your site. To avoid this problem, have your # administrator setup setgid permissions on the webserver to have your # htdocs directory set to your group and then use your group instead of # nogroup, or run in a virtual private server. To be safest, don't enable # comments. # # If you are unable to find out your webserver group and/or change your # directories' group to nogroup, then you can do what the GreyMatter # install says, and do: chmod 777 comments # # That of course means you don't have to do any of the chgrp commands # either, but you will have to have made the appropriate directories. # # If you want category support, then create a categorydir: # mkdir categorydir; chmod 755 categorydir # # Inside that directory, create directories for each category you want. # inside each category directory, create a hard link to (not a symbolic # link) with the same name of each blog entry you want in that category. # # Then, change the first line that says #!/bin/perl to #!/usr/bin/perl # or #!/usr/local/bin/perl depending on your perl installation location. # # Lastly, edit the templates in the source code as you please, but remember # that $ and @ are variable interpolating characters, so, so put \$ or \@ # if you want to use the characters literally. The unescaped $ and @ # references are subroutines and variables that can be used at any point # within the template. Remember that the backquote character ` should be # escaped if you want to use it literally as well because it's the template # quoting character. It's used inside templates for example to do the dirty # trick of repeating "for" loops. In the Content-type area at the top of each # template, you can send your own headers, but be sure that carriage returns # in the header and in the separating newline are "\r\n" instead of just the # standard newline "\n", or the webserver will not know what you're doing. # # Optional latest blog image support simply requires GD installed on the # server. For a phpBB latest blog image in your signature: # [url=http://example.com/][img]http://example.com/index.cgi?get=png[/img][/url] # # To check for if GD is installed: perl -e 'use GD' # To install GD if you don't have it: perl -MCPAN -e 'install GD' # # To use the .plan support, define your $webroot and $dotplan and make a # directory called $datadir/plan with webserver group permissions -- the script # will make a file called $datadir/plan/plan that is a symlink to the latest # blog file. Then symlink ~/.plan to the $datadir/plan/plan file so finger can # read it: mkdir plan; chgrp nogroup plan; chmod 775 plan # ################################################################################ #print "Content-type: text/plain\r\n\r\n$ENV{SCRIPT_NAME} $ENV{HTTP_HOST} $0 $ENV{PATH_INFO}"; ($basename, $filename) = ($ENV{SCRIPT_NAME} =~ /^(.*\/)(.*)$/); $homeurl = "http://$ENV{HTTP_HOST}$basename"; if ($filename eq "") { $filename = $0 } my $PI = $ENV{PATH_INFO}; $PI =~ s!^/!!; if ($PI ne '') { if ($PI !~ m!/!) { $ENV{QUERY_STRING} = ';get=post;post=' . $PI . ';' . $ENV{QUERY_STRING}; } else { # prevent response-splitting by filtering out newline stuff my ($entry, $cmd5) = ($PI =~ m!([^/\r\n\l\f]*)/?([^\r\n\l\f]*)!); if ($cmd5 ne '') { print "Location: $homeurl$filename/$entry#id$cmd5\r\n\r\n"; } else { print "Location: $homeurl$filename/$entry\r\n\r\n"; } exit 1; } } my ($QS, %args, $argsarray, %filetype, %filedata); &parsequerystring(); my (%entry, %entries, %comments, $commentglobal, %commentsenable); &grabdata(); # use Data::Dumper; # print STDERR Data::Dumper->Dump( # [ \%entries ], # [ 'entries'] # ); if (defined($dotplan)) { my @entries = reverse sort keys %entries; my $text = $entries{$entries[0]}{entry}; my $link = readlink "$dotplan"; my $target = "$webroot$datadir/$text"; #print STDERR qq{symlink $target, $dotplan}; if ($target ne $link) { unlink $dotplan or warn "$!"; #print STDERR qq{symlink $target, $dotplan}; symlink $target, $dotplan or warn "$!"; } } if ($args{"post"} ne '' and $entry{$args{"post"}} eq undef) { ################################################## 404 TEMPLATE BEGIN print qq`Status: 404 Entry Not Found\r @{[&htmlheader("@{[&plaintext($hometitle)]} - @{[&plaintext($homedescr)]}")]}

404 Not Found

The requested entry @{[&plaintext($QS)]} could not be found.

@{[&htmlfooter]}`; exit 1; ################################################## 404 TEMPLATE END } my $get = $args{"get"}; if($get eq "") { my ($lbb, $lbe) = &bound(scalar keys %entries, 'blog', $blogstart, $blogmax); ################################################## FRONT TEMPLATE BEGIN print qq`@{[&htmlheader("@{[&plaintext($hometitle)]} - @{[&plaintext($homedescr)]}")]}

@{[&plaintext($hometitle)]}

@{[&plaintext($homedescr)]}

@{[$#entries==-1?'

This blog is empty.

':'']}`; for my $entry (grep { $args{category} eq "" or $entries{$_}{categories}{$args{category}} == 1} (reverse sort keys %entries)[$lbb .. $lbe]) { print qq`
@{[&entrybody($entry)]}
`; } print qq` @{[&htmlfooter(1)]}`; ################################################## FRONT TEMPLATE END } elsif($get eq "post") { &commentpost(); local $entry = $entry{$args{"post"}}; ################################################## POST TEMPLATE BEGIN print qq`@{[&htmlheader("@{[&plaintext($hometitle)]} - @{[&plaintext($homedescr)]}")]}

@{[&plaintext($hometitle)]}

@{[&plaintext($homedescr)]}

@{[&entryheader($entry, undef)]} @{[&entrybody($entry,1)]}
`; for my $comment (reverse sort keys %{$comments{$entry}}) { print qq`@{[&commentheader($entry, $comment)]} @{[&commentbody($entry, $comment)]}`; } print qq`
@{[($commentsenable{$entry})?qq|

Leave A Comment

Secret is used for editing your own comment. If subject, secret, and name all are the same as a previous comment, it will be overwritten. Turing is the name of this program (look at the Source Code link on the front page), used to see if you are human.

|:qq|

If you would like to comment, make a blog entry that links to me, and in due time it will show up in the references section (if you aren't a spammer or use things like google ads). No, I do not support the broken spam-harboring protocols known as trackback and pingback, and I never will. There's already a standard: HTTP/1.1, RFC2616 of the IETF.

|]} @{[&htmlfooter]}`; ################################################## POST TEMPLATE END } elsif($get eq "rdf") { my ($lbb, $lbe) = &bound(scalar keys %entries, 'blog', $rdfstart, $rdfmax); ################################################## RDF TEMPLATE BEGIN print qq`Content-type: text/xml\r\n\r @{[&plaintext($hometitle)]} $homeurl @{[&plaintext($homedescr)]} $homelang `; for my $entry ((reverse sort keys %entries)[$lbb .. $lbe]) { print qq` `; } print qq` `; for my $entry ((reverse sort keys %entries)[$lbb .. $lbe]) { print qq` @{[&plaintext($entries{$entry}{entry})]} @{[&cuttext(&plaintext($entries{$entry}{etxt}),100)]} @{[&linktype($entry, $args{type})]} @{[&dctime($entries{$entry}{mti})]} `; } print qq` `; ################################################## RDF TEMPLATE END } elsif($get eq "css") { ################################################## CSS TEMPLATE BEGIN print qq`Content-type: text/css\r \r body { font-family: monospace; } `; ################################################## CSS TEMPLATE END } elsif($get eq "search") { ################################################## SEARCH TEMPLATE BEGIN print qq`@{[&htmlheader("@{[&plaintext($hometitle)]} - @{[&plaintext($homedescr)]}")]}

@{[&plaintext($hometitle)]}

@{[&plaintext($homedescr)]}

Search Entries and Comments

Browse by Category

@{[&search($args{search})]} @{[&htmlfooter]}`; ################################################## SEARCH TEMPLATE END } elsif(($get eq "png") || ($get eq "jpeg")) { my $height = 12; # per character my $width = 6; # per character my $maxtext = 100; # max text chars my @entries = reverse sort keys %entries; my $text = $entries{$entries[0]}{entry}; eval "use GD;"; binmode(STDOUT); $text = substr($text,0,$maxtext); $length = length($text) * $width + 2; my $im = new GD::Image($length,$height+1); $bg = $im->colorAllocate($bg[0],$bg[1],$bg[2]); $fg = $im->colorAllocate($fg[0],$fg[1],$fg[2]); if ($tp) { $im->transparent($bg) } $im->string(GD::Font->Small, 1, -1, $text, $fg); my $imdata; if ($get eq "png") { $imdata = $im->png } else { $imdata = $im->jpeg } my $imdatalen = length($imdata); print "Content-type: image/$get\r\nContent-length: $imdatalen\r\n\r\n$imdata"; } elsif($get eq "src") { print "Content-type: text/plain\r\n\r\n"; open(SOURCE, "<", "$filename"); { local $/; print ; } close(SOURCE); } elsif($get eq "refs") { local $entry = $entry{$args{"post"}}; open(SOURCE, "<", "$refsfile") or warn "$!"; local @refsdata = ; # for (@refsdata) { print "Content-type: text/plain\r\n\r\n$_"; } close(SOURCE); ################################################## REFS TEMPLATE BEGIN print qq`@{[&htmlheader("@{[&plaintext($hometitle)]} - @{[&plaintext($homedescr)]}")]}

@{[&plaintext($hometitle)]}

@{[&plaintext($homedescr)]}

References for $basename$filename@{[&plaintext($ENV{PATH_INFO})]}

@{[grabrefs("$basename$filename@{[&plaintext($ENV{PATH_INFO})]}", \@refsdata)]}
@{[&htmlfooter]}`; ################################################## REFS TEMPLATE END } else { print qq`Content-type: text/plain\r\n\r\nInvalid get type.`; } ################################################## TEMPLATE SUBROUTINES BEGIN sub htmlheader { my $titlehtml = shift; return qq`Content-type: $contenttype\r\n\r $titlehtml
`; } sub htmlfooter { my $front = shift; return qq`

[ Show All | References ( All ) | Search | RDF RSS 1.0 Feed ( Raw ) | Last Blog Image (PNG) (JPEG) | Browse Archive | Browse Comments | Browse Categories | XHTML 1.1 Valid | RSS 1.0 Valid | CSS Level 3 Valid | CSS File | PERL Source Code ]

user, system, child user, child system: @{[join(', ',times)]} seconds

`; } sub entrycategories { my $entry = shift; my $ret = qq``; for my $category (keys %{$entries{$entry}{categories}}) { $ret .= qq` @{[&plaintext($category)]}`; } $ret .= qq``; return $ret; } sub entryheader { my $entry = shift; my $link = shift; # boolean return qq`

@{[scalar localtime($entries{$entry}{mti})]} --@{[($link)?(($commentsenable{$entry})?qq| Post (Comments: @{[scalar keys %{$comments{$entry}}]}) --|:qq| Post (No Comments Allowed) --|):'']} @{[&plaintext($entries{$entry}{entry})]}

`; } sub entrybody { my $entry = shift; my $singlepost = shift; my $postdate = scalar localtime($entries{$entry}{cti}); my $cats = &entrycategories($entry); my $catsnohtml = $cats; $catsnohtml =~ s/<.*?>//g; my $padding = ($line - length($postdate . $hometitle . $catsnohtml)) / 2; my $paddingl = " " x int($padding+.5); my $paddingr = " " x int($padding); my $creditline = qq{$postdate$hometitle$cats}; $creditline =~ s/\Q$postdate\E/@{[scalar localtime($entries{$entry}{mti})]}<\/span>/; $creditline =~ s/ /  /g; return qq`

@{[&plaintext($entries{$entry}{entry})]}(@{[scalar keys %{$comments{$entry}}]})

@{[&prettify(&imagify(&plaintext($entries{$entry}{etxt},8),$singlepost))]}
$creditline
`; } sub commentheader { my $entry = shift; my $comment = shift; return qq`

@{[scalar localtime($comments{$entry}{$comment}{mti})]} -- Comment @{[&plaintext($comments{$entry}{$comment}{csub})]} -- by @{[&plaintext($comments{$entry}{$comment}{caut})]}

`; } sub commentbody { my $entry = shift; my $comment = shift; return qq`

@{[&plaintext($comments{$entry}{$comment}{csub})]}

@{[&plaintext($comments{$entry}{$comment}{ctxt},8)]}

`; } sub linktype { my $entry = shift; my $type = shift; return ($type ne "raw") ? "$homeurl$filename@{[&linkup(&uriescape($entries{$entry}{entry}))]}" : "$homeurl$datadir/@{[&uriescape($entries{$entry}{entry})]}"; } ################################################## TEMPLATE SUBROUTINES END sub bound() { my $entries = shift; my $name = shift; my $start = shift; my $max = shift; my $lstart = ($args{"${name}start"})?$args{"${name}start"} : $start ; $lstart = ($lstart <= "0") ? 10000000000000000000 : $lstart; $lstart = ($lstart > $entries) ? $entries : $lstart; my $entrymax = $entries - $lstart; my $lmax = ($args{"${name}max"})?$args{"${name}max"}-1 : $max - 1; $lmax = ($lmax < "0") ? 1000000000000000000000 : $lmax ; $lmax = ($lmax > $entrymax) ? $entrymax : $lmax ; return ($lstart - 1, $lstart + $lmax - 1); } sub imagify() { local $_ = shift; my $singlepost = shift; # add link support, this is trusted coding, do not let untrusted users run this. s/\[url\](.*?):(.*?):(.*?)\[\/url\]/$3<\/a>/g; # add youtube embed support, this is trusted coding, do not let untrusted users run this. s!\[video\]([^ ]*?)\[\/video\]![video]$1&autoplay=1[/video]! if $singlepost; # only the first entry of a single post autoplays! # s!\[gvideo\]([^ ]*?)\[\/gvideo\]!!g; s!\[video\]([^ ]*?)\[\/video\]!!g; # add image support, this is trusted coding, do not let untrusted users run this. s/\[img\](.*?):(.*?):(.*?):(.*?):(.*?)\[\/img\]/$2/g; # add code support, this is trusted coding, do not let untrusted users run this. s/(?:
\n){0,1}\[code\](.*?)\[\/code\](?:
\n){0,1}/"\n <\/p>\n" . '
' . &filteroutcode($1) . "<\/pre>\n        
\n"/gse;
  return $_;
}

sub unplaintext() {
  local $_ = shift;
  return $_;
}

sub prettify() {
  local $_ = "
" . shift() . "
";

  # subheaders

  s/(?:
|)[\n\t\r\l ]*==== ([^\n=]+) ====[\n\t\r\l ]*(?:<\/p>|)/
$1<\/h6>/gs;
  s/(?:
|)[\n\t\r\l ]*=== ([^\n=]+) ===[\n\t\r\l ]*(?:<\/p>|)/
$1<\/h5>/gs;
  s/(?:
|)[\n\t\r\l ]*== ([^\n=]+) ==[\n\t\r\l ]*(?:<\/p>|)/
$1<\/h4>/gs;
  s/(?:
|)[\n\t\r\l ]*= ([^\n=]+) =[\n\t\r\l ]*(?:<\/p>|)/
$1<\/h3>/gs;

  # linkify links

   s/([^"a-z])([a-z]+\:\/\/[A-Z0-9a-z.-:]+\/?[^\t\n\l\r<" ]*)/$1$2<\/a>/gs;

  # nested unordered lists

  s/^(\ \;| )+\* (.*)/