#!/usr/bin/perl # -------------------------------------------------------- PerlInterpreter # Wiki code by Rich DeVaul, based on original code # Copyright (c) 1995, Cunningham & Cunningham, Inc. # -------------------------------------------------------- InitialComments use DB_File; $SCRIPT_NAME = $ENV{SCRIPT_NAME}; $SERVER_NAME = $ENV{SERVER_NAME}; $CDB = "/home/web/httpd/wiki/uberconfig"; ## Do uberwiki config based on CDB $FieldSeparator = "\263"; tie (%cdb,"DB_File",$CDB) || &AbortScript("can't open $CDB"); $configName= $SERVER_NAME; $configName =~ s/\./dot/g; $newConfigName = $SCRIPT_NAME; $newConfigName =~ s/\/[^\/]+$//; $newConfigName =~ s/\//slash/g; $newConfigName = $configName . $newConfigName; $configName=havendotorg ; $newConfigName=havendotorg ; sub SelectConfig { local ($name,$depth) = @_; local (%cfg); if ($depth > 10) { return %cfg; } $name =~ s/\./dot/g; $name =~ s/\//slash/g; %cfg = split($FieldSeparator, $cdb{$name}); if ($cfg{symlink} ne "") { return SelectConfig($cfg{symlink},$depth+1); } $configName = $name; return %cfg; } %config = SelectConfig($newConfigName,1); $DefaultTitle=$config{DefaultTitle} || "FrontPage"; $RecentChanges=$config{RecentChanges} || "RecentChanges"; $DefaultTemplate=$config{DefaultTemplate} || "\#\#1 $SERVER_NAME \#\#\n(([Title]))\n"; $ScriptName=$config{ScriptName} || $SCRIPT_NAME; $ScriptUrl=$config{ScriptUrl} || "https://$SERVER_NAME/"; $defaultTextColor=$config{defaultTextColor} || "#000000"; $voiceFont[1]= $config{voiceFont1} || "color=\"#D0FFFF\""; $voiceFont[2]= $config{voiceFont2} || "color=\"#FFA0C0\""; $voiceFont[3]= $config{voiceFont3} || "color=\"#A0FFD8\""; $voiceFont[4]= $config{voiceFont4} || "color=\"#10A0F0\""; $templateName=$config{templateName} || "DefaultTemplate"; $thanksText=$config{thanksText}; ## "thank you" wiki text $abortText=$config{abortText}; ## "abort" wiki text $BodyTag=$config{BodyTag} || "
"; $HeaderAddInfo=$config{HeaderAddInfo}; ## extra header info $Rss=$config{RSS} || "/tmp/$SERVER_NAME"; $UploadDirectory=$config{UploadDirectory} || "/tmp/$SERVER_NAME" . "_upload"; untie(%cdb); # -------------------------------------------------------- defaultTextmColor $textcolor = $defaultTextColor; $cookedcolor = ""; $defaultOptions = ""; # -------------------------------------------------------- ScriptName $DataBase = "/home/web/httpd/wiki/pages/$ScriptName"; # -------------------------------------------------------- MasterPasswords open(PASSLIST, "/home/wiki/passwords") || warn "Can't open /home/wiki/passwords: $!\n"; while(
This information has been logged. The
intended purpose for viewing access restriction is to
discurage search engines from indexing specific wiki pages.
The intended purpose for setting editing passwords is to
provide weak security for journal authors in the upgraded
journal mode.
Change text color:
This form allows you to change the default text foreground
color. Your color selection will "follow" you as you navigate
the wiki.
";
if ($rdepth > 10)
{
$text= " RECURSIVE DEPTH LIMIT of 10 EXCEEDED ";
}
else {
%old = %current;
%current = &RetrievePage($title);
if ( $current{worldview} eq "no" && $current{vpwd} && $current{vpwd} ne "none" && $vpwd ne $MasterViewPass && $current{vpwd} ne $vpwd ) {
return " Correct viewing pasword required for $title ";
}
$text = $current{text};
$text = &EscapeMetaCharacters($text);
$text = &ProcessBodyText($title,$text,$rdepth,%current);
%current = %old;
}
return $text
}
# -------------------------------------------------------- RecursePage
sub bob {
local($_) = pop(@_);
# local($left,$center,$right);
local ($localInc);
local ($text);
($_ eq "") && return "";
if (/<(.*?)>/s) {
my $left = $`;
my $center = $&;
my $right = $';
$center =~ s/&/&/;
return(&bob($left) . $center . &bob($right));
} else {
while (s/\b((http)|(https)|(ftp)|(mailto)|(news)|(file)|(gopher)):[^\s\<\>\[\]"'\(\)]*[^\s\<\>\[\]"'\(\)\,\.\?]/$TranslationToken$InPlaceUrl$TranslationToken/)
{
$InPlaceUrl[$InPlaceUrl++] = $&;
}
while (s/\(\(($LinkPattern)\)\)/$incToken$incCounter$incToken/) {
print "\n";
# print "\n";
$localInc= $incCounter++;
$incArray[$localInc] = &RecursePage($1,$rdepth);
# foreach (split(/\n/,$incArray[$localInc])) {
# print "\n";
print "\n";
# $incArray[$incCounter++] = "$1";
}
s/\b$LinkPattern\b/&AsAnchor($&)/geo;
s/$EscapedPattern\b/$1/g;
s/\[\[(]+>)[^<]*(<\/a>)\s([^\]]+)\]\]/$1$3$2/gio;
s/\[\[[^<]+(]+>\?<\/a>)\s([^\]]+)\]\]/$2$1/gio;
return($_);
}
}
# ------------------------------------------------------- Bob
sub ProcessTemplateText {
local($text) = @_;
$oldtext = $_;
$_= $text;
# Truly frightening stuff
s/\[eval (.*?) EVALEOF\]/eval $1/geo;
$outtext=$_;
$_ =$oldtext;
return $outtext;
}
sub scalarIndirect {
local($sn, $rdepth) = @_;
local($text);
$rdepth += 1;
if ($rdepth > 10)
{
$text= " RECURSIVE DEPTH LIMIT of 10 EXCEEDED ";
}
else {
%old = %current;
$text = &EscapeMetaCharacters($$sn);
$text = &ProcessBodyText($title,$text,$rdepth+1,%current);
%current = %old;
}
return $text;
}
sub callIndirect {
local($subname) = @_;
local($result);
if ($config{$subname}) {
$result = eval $config{$subname};
$result =~ s/text_area/textarea/ig;
}
else {
$result = "<<UNKNOWN SYMBOL $subname >>";
}
return $result;
}
sub ProcessBodyText {
local($title,$text,$rdepth,%current);
($title,$text,$rdepth,%current) = @_;
local($oldtext,$outtext);
$oldtext = $_;
$_ = &bob($text);
## Convert the sequence ==> into one tab character for the
## purposes of other markup conventions ##
s/==>/\t/gs;
s/\\\n/ /g;
s/\\\\/ / && ($code = '...');
s/^(\t+)(.+):\t/
Please enter the appropriate password in the text area below
Please enter the appropriate password in the text area below
GoodStyle tips for editing.
Please enter the appropriate password in the text area below
GoodStyle tips for editing.
Type the full URL (http:// ...) for each reference cited in the text.
EOF
}
# -------------------------------------------------------- HandleLinks
sub HandleSearch {
local($m, $n, @rec);
$pat = $CookedInput{search};
$pat =~ s/[+?.*()[\]{}|\\]/\\$&/g;
$results = Results;
$results = "for $&" if $pat =~ /\W+/;
print < Back to $back";
}
&CookSpaces;
&RequestLock;
use DB_File;
tie(%db,"DB_File",$DataBase) || &AbortScript("can't open $DataBase for update\n");
## dbmopen(%db, $DataBase , 0666) || &AbortScript("can't open $DataBase for update\n");
%old = &RetrievePage($title);
$old{recent_hit_counter}=0;
&BackupCopy;
# Handle request for setting page edit password
if ( $CookedInput{type} eq "epwd" ) {
print("\n");
print("\n");
# $MasterEditPass is the default password for all pages
if (!$old{epwd}) { $old{epwd}=$MasterEditPass; }
# "none" means no password, $MasterEditPass
# is the master password.
if ($old{epwd} ne "none" &&
$CookedInput{oldepwd} ne $old{epwd} && $CookedInput{oldepwd} ne $MasterEditPass) {
print("\n");
print("\n");
untie(%db);
# dbmclose(%db);
&ReleaseLock;
&AbortScript("Old password does not match");
}
# Check to see if we are setting the password
if ( $CookedInput{epwd1} ne "" && $CookedInput{epwd2} ne "" ) {
# It appears that we are attempting to set a password
# new passwords must agree
if ( $CookedInput{epwd1} ne $CookedInput{epwd2} ) {
print("\n");
untie(%db);
## dbmclose(%db);
&ReleaseLock;
&AbortScript("New passwords are not the same");
}
# assigning new edit password
print("\n");
$old{epwd} = $CookedInput{epwd1};
}
# Assign viewing status
$old{worldwrite}= $CookedInput{worldwrite}
}
# Handle request for setting page view options
elsif ( $CookedInput{type} eq "vpwd" ) {
print("\n");
print("\n");
# $MasterViewPass is the default password for all pages
if (!$old{vpwd}) { $old{vpwd}=$MasterViewPass; }
# "none" means no password, $MasterViewPass
# is the master password.
if ($old{vpwd} ne "none" &&
$CookedInput{oldvpwd} ne $old{vpwd} && $CookedInput{oldvpwd} ne $MasterViewPass) {
print("\n");
print("\n");
untie(%db);
# dbmclose(%db);
&ReleaseLock;
&AbortScript("Old password does not match");
}
# Check to see if we are setting the password
if ( $CookedInput{vpwd1} ne "" && $CookedInput{vpwd2} ne "" ) {
# It appears that we are attempting to set a password
if ( $CookedInput{vpwd1} ne $CookedInput{vpwd2} ) {
print("\n");
untie(%db);
## dbmclose(%db);
&ReleaseLock;
&AbortScript("New passwords are not the same");
}
print("\n");
$old{vpwd} = $CookedInput{vpwd1};
}
# Assign viewing status
$old{worldview}= $CookedInput{worldview}
}
else {
for (keys(%CookedInput)) {
next if /post/ || /form/ || /title/;
if ( $CookedInput{$_} && ! ($CookedInput{$_} =~ /^[ \n\r]*$/s )) {
$old{$_} = $CookedInput{$_};
}
}
if ( $CookedInput{new_journal_text} && ! ($CookedInput{new_journal_text} =~ /^[ \n\r]*$/s )) {
$old{journal_text} = $CookedInput{new_journal_text} . "\n\n" . $old{journal_text};
}
}
&ReplacePage($title, *old);
%rc = &RetrievePage($RecentChanges);
if ( $rc{text} eq "" ) {
$rc{text} = "##1Recent Changes## \n";
}
$rc{text} =~ s/\t\* $title .*\n//;
$rc{text} =~ s/$DateToday .*\n//;
$rc{text} =~ s/(##1Recent Changes##.*?\n)/$1\n$DateToday \n\t* $title {{([Hit Counter !!$title] hits)}} . . . . . . $TimeStamp EDT/s;
&ReplacePage($RecentChanges, *rc);
$anchor = &AsAnchor($title);
untie(%db);
##dbmclose(%db);
&ReleaseLock;
## Attempt to add support for RSS feed
if ( open (RSS, "<$Rss.xml") != 0 ) {
read(RSS,$rssdata,10000);
close RSS;
}
else {
$rssdata= <
$backstring
p.s. Be sure to Reload your old pages.
Please copy the file name for future reference. In general, you probably want to notify Rich about the upload so that he can restore the proper file name and type and move the file to somewhere more appropriate. However, you can now download your file from its present location as a subdirectory of https://borglab.com/uploads/.
Use the "back" button on your browser to return to the borglab wiki.
We are sorry for any inconvenince.
EOF
die $msg;
}
# -------------------------------------------------------- AbortScript
# -------------------------------------------------------- DefaultTitle
$linkWord = "[A-Z][a-z]+";
$LinkPattern = "(?\n" . $BodyTag;
$bt =~ s/\$($metaVarPattern)/$$1/go;
return $bt;
}
# -------------------------------------------------------- LinkPattern
$DefaultRequest = "browse";
# -------------------------------------------------------- DefaultRequest
if ($ENV{REQUEST_METHOD} eq GET){
$RawInput = $ENV{QUERY_STRING} || $DefaultTitle;
$RawInput =~ s/^($LinkPattern)/$DefaultRequest=$1/;
}
if ($ENV{REQUEST_METHOD} eq POST){
read(STDIN, $RawRawInput, $ENV{CONTENT_LENGTH});
$RawInput=$RawRawInput;
}
# -------------------------------------------------------- RawInput
$RawInput =~ s/\+/ /g;
foreach $_ (split(/&/, $RawInput)) {
s/\%(..)/pack(C, hex($1))/ge;
s/$FieldSeparator//go;
($_, $CookedInput) = split (/=/, $_, 2);
$CookedInput{$_} = $CookedInput;
}
# -------------------------------------------------------- CookedInput
# -------------------------------------------------------- LogoUrl
sub SetDefaultTextColor {
local($tc) = @_;
$defaultTextColor=$tc;
return "";
}
sub ProcessVoice {
local ($vn, $font) = @_;
$voiceFont[$vn] = $font;
return "";
}
sub ProcessMeta {
$meta = $meta . "\n";
return "";
}
sub ProcessMetaLink {
$meta = $meta . "\n";
return "";
}
# -------------------------------------------------------- ProcessVoice
$LogoImage = "";
$LogoImage2 = "";
# -------------------------------------------------------- SubLogoImage2
##$ScriptUrl = "https://devaul.net/cgi-bin/$ScriptName";
# -------------------------------------------------------- ScriptUrl
sub RetrievePage {
local($title) = pop(@_);
split($FieldSeparator, $db{$title} ||
"text${FieldSeparator}Describe $title here.");
}
# -------------------------------------------------------- RetrievePage
sub EscapeMetaCharacters {
$text = pop(@_);
$text =~ s/&/&/g;
$text =~ s/</g;
$text =~ s/>/>/g;
return $text;
}
# -------------------------------------------------------- EscapeMetaCharacters
sub InPlaceUrl {
local($num) = (@_);
local($ref) = $InPlaceUrl[$num];
"$ref";
}
# -------------------------------------------------------- InPlaceUrl
$TranslationToken = $FieldSeparator;
$incToken= "
Access Control for $title
This form allows you to assign or change the viewing and
editing passwords associated with $title, and to change the
access control options for this page. Unless this wiki is
served by an ssl-only server, restrictions imposed here will
provide modest security at best.
WITHOUT SSL ENCRYPTION, ANYONE WITH A PACKET SNIFFER ON THE
WIRE CAN TRIVIALLY INTERCEPT THESE PASSWORDS. YOU HAVE BEEN
WARNED.
Viewing Options
Setting the vieweing password to a value other than
"none" will require viewers to provide this password
in order to view $title if the viewing status is
"restricted" You must provide the current edit
password in order to make changes.
Editing Options
The edit password provides access control for viewing
and editing $title. You may use this form to toggle
the "world writable" status of the page. You must
provide the current edit password in order to make
changes.
$title Journal
Edit this journal in its
entirety. Modify
page access control.
EOF
return $footext;
}
# -------------------------------------------------------- JournalForm
sub HitCounter {
local($title,%tc) = @_;
%tc = RetrievePage($title);
return $tc{hit_counter};
}
# -------------------------------------------------------- HitCounter
sub RecentHitCounter {
local($title,%tc) = @_;
%tc = RetrievePage($title);
return $tc{recent_hit_counter};
}
# -------------------------------------------------------- RecentHitCounter
sub ColorSelectionForm {
local($title) = pop(@_);
$theColorSelectionForm = <
$cookedJournal
default
reddish
greenish
blueish
"wiki classic" white
/gs;
s/%%(.*?)%%/ tag matching was modified so that it would not
# --- mistakenly match /sgi;
s/<\/tr( *?)>/<\/TR>/sgi;
s/<(\/?)td(.*?)>/<$1TD $2>/sgi;
# ----- attempt to add support for IFRAME tag
s/<(\/?)iframe(.*?)>/<$1IFRAME $2>/sgi;
s/\"{2}(.*?)\"{2}/$1<\/big>/gs;
s/'{3}(.*?)'{3}/$1<\/strong>/gs;
s/'{2}(.*?)'{2}/$1<\/em>/gs;
## do some basic despaming... #
s/@/@/g;
foreach (split(/\n/, $_))
{
# --------------------------------- attempt to add anchor support
# ---------------------------------------- direct image inlining support
$code = "";
s/^\s*$/ $1<\/H1>/g;
# s/##2(.*?)##/
The results returned by your file upload are below. Please note that the file name is randomly generated and the file type is likely to be set to "text." However, your file data should be preserved.$1<\/H2>/g;
# s/##3(.*?)##/
$1<\/H3>/g;
# s/##4(.*?)##/
$1<\/H4>/g;
# s/##5(.*?)##/
$1<\/H5>/g;
# Attempt to add comment syntax
s/^\/\/(.*?)\r//;
s/^-----*/
/;
s/\[(\d+)\]/&AsLink($1,%current)/geo;
s/$TranslationToken(\d+)$TranslationToken/&InPlaceUrl($1)/geo;
s/$incToken(\d+)$incToken/"\n$incArray[$1]"/geo;
# ---------------------------------------- attempt to add in-page edit link
s/\[Title\]/$title/ge;
s/\[edit\]/Edit $title<\/a>/go;
s/\[edit ($LinkPattern)\]/Edit $1<\/a>/go;
s/\[access\]/Access Control for $title<\/a>/go;
s/\[Search\]/$SearchForm/;
# add scriptURL substitution for use in tags.
s/\[Script Url\]/$ScriptUrl/ge;
s/\[Default Color\]/$cookedcolor/ge;
s/\[Default Options\]/$defaultOptions/ge;
s/\[Color Selection\]/&ColorSelectionForm($title)/e;
s/\[Hit Counter\]/&HitCounter($title)/e;
s/\[Hit Counter ($LinkPattern)\]/&HitCounter($1)/e;
s/\[Recent Hit Counter\]/&RecentHitCounter($title)/e;
# ------------------------------------------------------ Journal Support
s/\[Journal\]/&JournalForm($title)/e;
s/\[Password Change\]/&PasswordChangeForm($title)/e;
s/\[Password Change ($LinkPattern)\]/&PasswordChangeForm($1)/e;
# ------------ Deeply Frightening Subrotine and Scalar Evaluation Support
# This syntax does not do "wiki" text expansion:
s/\[scalar ($metaVarPattern)\]/$$1/go;
# ------------ Alternate syntax -- this _does_ do wiki text expansion
s/\$($metaVarPattern)/scalarIndirect($1)/geo;
s/\[callsub ($metaVarPattern)\]/callIndirect($1)/geo;
#print "$_\n";
$outtext="$outtext$_\n";
}
$outtext = $outtext.&ProcessCode("", 0);
$_ = $oldtext;
return $outtext;
}
# -------------------------------------------------------- ProcessBodyText
sub ExtractColor {
$textcolor = $CookedInput{textcolor};
if ($textcolor eq "") {
$textcolor = $defaultTextColor;
}
$cookedcolor = $textcolor;
$cookedcolor =~ s/\#/\%23/g;
$defaultOptions = "&textcolor=$cookedcolor";
if ($title) {
$defaultOptions = $defaultOptions."&back=$title";
}
if ($CookedInput{vpwd}) {
$defaultOptions = $defaultOptions."&vpwd=$CookedInput{vpwd}";
}
if ($CookedInput{epwd}) {
$defaultOptions = $defaultOptions."&epwd=$CookedInput{epwd}";
}
}
# -------------------------------------------------------- ExtractColor
sub HandleBrowse {
$title = $CookedInput{browse};
$vpwd = $CookedInput{vpwd};
$meta = <
Password Required
The page you are trying to access is password protected.
to view the page.
EOF
untie(%db);
## dbmclose(%db);
&ReleaseLock;
return;
}
## Increment the hit counters
$old{hit_counter} = $old{hit_counter}+1;
$old{recent_hit_counter} = $old{recent_hit_counter} +1;
&ReplacePage($title, *old);
&ReleaseLock;
$date=$old{date};
$templateName = $old{template} ? $old{template} : $templateName;
if ($templateName eq "default") {
$templateName="DefaultTemplate";
}
if (%template = &RetrievePage($templateName)) {
$rawTemplate = $template{text};
}
else {
$rawTemplate = $DefaultTemplate;
$template{text} = $rawTemplate;
}
$_ = $rawTemplate;
s/\[Script Url\]/$ScriptUrl/ge;
s/\[Title\]/$title/ge;
s/\[Edit Date\]/$date/ge;
# --- edit voice stuff
s/\[Voice ([1-9]) (.*?)\]/&ProcessVoice($1,$2)/ge;
s//&ProcessMeta($1)/ge;
s//&ProcessMetaLink($1)/ge;
# --- set default text color
s/\[DefaultTextColor (.*?)\]/&SetDefaultTextColor($1)/ge;
$_ = &EscapeMetaCharacters($_);
$InPlaceUrl = 0;
$incCounter = 0;
$rdepth = 0;
# foreach (split(/\n/,$_)) {
# print "\n";
print <
Access Control for $title
EOF
print &PasswordChangeForm($title);
print "\n";
}
# -------------------------------------------------------- HandleAccess
sub HandleEdit {
$title = $CookedInput{edit} || $CookedInput{copy};
$title =~ /^$LinkPattern$/ || &AbortScript("edit: improper name: $title");
$backtitle = $CookedInput{back} ? $CookedInput{back} : $title;
&ExtractColor;
%old = &RetrievePage($title);
# extract edit password
$epwd = $CookedInput{epwd};
# figure optional parameters for
# hidden form input, less edit
# password (in case the edit password
# is wrong and needs to be provided by
# the user in the next block of code).
$options = &FormOptions;
if ( $old{worldwrite} eq "no" && $old{epwd} && $old{epwd} ne "none"
&& $epwd ne $MasterEditPass && $old{epwd} ne $epwd ) {
print <
Edit Password Required
The page you are trying to access is password protected.
to edit the page.
EOF
untie(%db);
## dbmclose(%db);
&ReleaseLock;
return;
}
# -------------------- extract template
$template = $old{template} ? $old{template} : "$templateName";
$_ = $CookedInput{copy} ? $old{copy} : $old{text};
$note = 'Copy of ' if $CookedInput{copy};
# deal with CR/LF
s/\r\n/\n/g;
# escape stuff
$_ = &EscapeMetaCharacters($_);
# default tab conversion?
$convert = "checked" if $ENV{HTTP_USER_AGENT} =~ /WebExplorer/;
# print the edit form
print <
$note$title
Back to $backtitle (quit without changes)
I can't type tabs.
Please ConvertSpacesToTabs
for me when I save.
EditLinks to other web servers.
EOF
# Optional "copy" block
print <
EOF
# Continue main form body
print <
Edit Password Required
The page you are trying to access is password protected.
to edit the page.
EOF
untie(%db);
## dbmclose(%db);
&ReleaseLock;
return;
}
# Extend options with edit password
if ($CookedInput{epwd}) {
$options = $options."\n";
}
# -------------------- extract template
$template = $old{template} ? $old{template} : "$templateName";
$_ = $old{journal_text};
# deal with CR/LF
s/\r\n/\n/g;
# escape stuff
$_ = &EscapeMetaCharacters($_);
# default tab conversion?
$convert = "checked" if $ENV{HTTP_USER_AGENT} =~ /WebExplorer/;
# print the edit form
print <
$note$title
Back to $title (quit without changes)
I can't type tabs.
Please ConvertSpacesToTabs
for me when I save.
EditLinks to other web servers.
EOF
# Optional "copy" block
print <
EOF
# Continue main form body
print <$title Links
[1]
[2]
[3]
[4]
[5]
[6]
[7]
[8] Search $results
\n";
}
}
$m = $m || No;
print "
$m pages found out of $n pages searched.";
}
# -------------------------------------------------------- HandleSearch
sub CookSpaces {
$CookedInput{text} =~ s/ {3,8}/\t/g
if $CookedInput{convert};
}
# -------------------------------------------------------- CookSpaces
$LockDirectory = "/tmp/$ScriptName";
# -------------------------------------------------------- LockDirectory
sub RequestLock {
local ($n) = 0;
while (mkdir($LockDirectory, 0555) == 0) {
$! == 17 || &AbortScript("can't make $LockDirectory: $!\n"); # EEXIST == 17 is OK, try later.
$n++ < 30 || &AbortScript("timed out waiting for $LockDirectory\n");
sleep(1);
}
}
# -------------------------------------------------------- RequestLock
sub BackupCopy {
$old{copy} = $old{text}
if $old{host} && $old{host} ne $ENV{REMOTE_HOST};
}
# -------------------------------------------------------- BackupCopy
($sec, $min, $hour, $mday, $mon, $year) = localtime($^T);
$DateToday = (January, February, March, April, May, June, July,
August, September, October, November, December)[$mon]
. " " . $mday . ", " . ($year+1900);
if ($min < 10) {
$TimeStamp = $hour . ":0" . $min;
}
else {
$TimeStamp = $hour . ":" . $min;
}
# -------------------------------------------------------- DateToday
sub ReplacePage {
local($title, *page) = @_;
local($value, @value);
$page{date} = $DateToday;
$page{host} = $ENV{REMOTE_HOST};
$page{agent} = $ENV{HTTP_USER_AGENT};
$page{rev}++;
@value = %page;
$value = join($FieldSeparator, @value);
open (WDB, ">$DataBase.wdb/$title");
print WDB $value;
close WDB;
$db{$title} = $value;
}
# -------------------------------------------------------- ReplacePage
sub ReleaseLock {
rmdir($LockDirectory);
}
# -------------------------------------------------------- ReleaseLock
#$SignatureUrl = "https://borglab.com/signature.jpg";
# -------------------------------------------------------- SignatureUrl
sub HandlePost {
$title = $CookedInput{post};
$back = $CookedInput{back};
&ExtractColor;
if ($back) {
$backstring="
EOF
}
# -------------------------------------------------------- HandlePost
sub HandleSpecial {
$action= $CookedInput{special};
$title = $CookedInput{$action};
&ExtractColor;
print <\n";
for (keys(%dict)){print "
\n";
}
# -------------------------------------------------------- DumpBinding
# InitialComments
print "Content-type: text/html\n\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
use DB_File;
tie(%db,"DB_File",$DataBase) || &AbortScript("can't open $DataBase for update\n");
##dbmopen(%db, $DataBase , 0666) || &AbortScript("can't open $DataBase");
if ($ENV{REQUEST_METHOD} eq GET){
SWITCHONE: {
$CookedInput{browse} && do { &HandleBrowse; last SWITCHONE; };
$CookedInput{edit} && do { &HandleEdit; last SWITCHONE; };
$CookedInput{journal} && do { &HandleJournalEdit; last SWITCHONE; };
$CookedInput{copy} && do { &HandleEdit; last SWITCHONE; };
$CookedInput{links} && do { &HandleLinks; last SWITCHONE; };
$CookedInput{search} && do { &HandleSearch; last SWITCHONE; };
$CookedInput{access} && do { &HandleAccess; last SWITCHONE; };
$CookedInput{special} && do { &HandleSpecial; last SWITCHONE; };
&AbortScript("Unknown operation or request:\n$RawInput");
}
untie(%db);
}
##dbmclose (%db);
if ($ENV{REQUEST_METHOD} eq POST) {
SWITCHTWO: {
if ($CookedInput{post}) { &HandlePost; last SWITCHTWO; }
if ($CookedInput{special}) { &HandleSpecial; last SWITCHTWO; }
use MIME::Parser;
### Create parser, and set some parsing options:
my $parser = new MIME::Parser;
$parser->output_under($UploadDirectory);
### Parse input:
$entity = $parser->parse_data($RawRawInput) or &AbortScript("parse failed");
### Take a look at the top-level entity (and any parts it has):
print <Upload Status Information
EOF
$entity->dump_skeleton;
print <