#!/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() { if ($_ =~ /^$ScriptName Edit (\S+)$/) {$MasterEditPass=$1;} if ($_ =~ /^$ScriptName View (\S+)$/) {$MasterViewPass=$1;} } if (!$MasterEditPass) {$MasterEditPass = "Shells";} if (!$MasterViewPass) {$MasterViewPass = "nemo";} # -------------------------------------------------------- DataBase sub AbortScript { local ($msg) = @_; print <The Wiki Wiki Server Can't Process Your Request $msg

This information has been logged.
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; return $text; } # -------------------------------------------------------- EscapeMetaCharacters sub InPlaceUrl { local($num) = (@_); local($ref) = $InPlaceUrl[$num]; "$ref"; } # -------------------------------------------------------- InPlaceUrl $TranslationToken = $FieldSeparator; $incToken= ""; # -------------------------------------------------------- TranslationToken sub EmitCode { ($code, $depth) = @_; while (@code > $depth) { local($_) = pop @code; print "\n"} while (@code < $depth) { push (@code, ($code)); print "<$code>\n"} if ($code[$#code] ne $code) { print "<$code>\n"; $code[$#code] = $code;} } # -------------------------------------------------------- EmitCode sub ProcessCode { ($code, $depth) = @_; local($localfoo); $localfoo=""; while (@code > $depth) { local($_) = pop @code; $localfoo = "$localfoo\n"} while (@code < $depth) { push (@code, ($code)); $localfoo = "$localfoo<$code>\n"} if ($code[$#code] ne $code) { $localfoo = "$localfoo<$code>\n"; $code[$#code] = $code;} return $localfoo; } # -------------------------------------------------------- ProcessCode sub AsAnchor { local($title) = pop(@_); defined $db{$title} ? "$title<\/a>" : "$title?<\/a>"; } # -------------------------------------------------------- AsAnchor sub AsNamedAnchor { local($title, $titlename)=@_; defined $db{$title} ? "$titlename<\/a>" : "$titlename?<\/a>"; } # -------------------------------------------------------- AsNamedAnchor sub AsLink { local($num, %current) = @_; local($ref) = $current{"r$num"}; defined $ref ? ($ref =~ /\.jpg$/i ? "" : $ref =~ /\.gif$/i ? "" : $ref =~ /\.png$/i ? "" : "[$num]<\/a>") : "[$num]"; } # -------------------------------------------------------- AsLink $SearchForm = < <\/form> EOF # -------------------------------------------------------- SearchForm sub FormOptions { local($options); $options = "\n"; if ($CookedInput{back}) { $options = $options."\n"; } if ($CookedInput{vpwd}) { $options = $options."\n"; } if ($CookedInput{epwd}) { $options = $options."\n"; } return $options; } sub PasswordChangeForm { local ($title, %tc, $footext, $options, $yvcheck, $nvcheck, $ywcheck, $nwcheck, $back); $title = pop(@_); %tc = RetrievePage($title); $back = $CookedInput{back}; &ExtractColor; $backtitle = $CookedInput{back} ? $CookedInput{back} : $title; $options=&FormOptions; if (!$tc{vpwd} || $tc{vpwd} eq "none") { $disview = "readonly"; } if ($tc{worldview} eq "no") { $yvcheck=""; $nvcheck="checked"; } else { $yvcheck="checked"; $nvcheck=""; } if (!$tc{epwd} || $tc{epwd} eq "none") { $diswrite = "readonly"; } if ($tc{worldwrite} eq "no") { $ywcheck=""; $nwcheck="checked"; } else { $ywcheck="checked"; $nwcheck=""; } $footext = <

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.

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.

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.
$options




world viewable
password required

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.
$options




world writable
password required

Return to $backtitle (Quit without making changes).
EOF return $footext; } # ---------------------------------------------------- PasswordChangeForm sub JournalForm { local ($title,%tc, $cookedJournal,$footext); $title = pop(@_); %tc = RetrievePage($title); $cookedJournal = $tc{journal_text}; $cookedJournal = &EscapeMetaCharacters($cookedJournal); $cookedJournal = &ProcessBodyText($title,$cookedJournal,$rdepth+1, %current); $options = &FormOptions; $footext = <

$title Journal

Edit this journal in its entirety. Modify page access control.

$options
$cookedJournal 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 = <

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.
default
reddish
greenish
blueish
 "wiki classic" white

You may also select a new default foreground color by typing its description (such as #10F030 or red) into the box below and hitting "Enter." The default is the current text color.

EOF return $theColorSelectionForm; } # -------------------------------------------------------- ColorSelectionForm sub RecursePage { local($title, $rdepth, $text); local(%old); ($title, $rdepth) = @_; $rdepth += 1; # print "Depth=$rdepth

"; 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/\\\\/
/gs; s/%%(.*?)%%/

$1<\/center>/gs; s/\${2}([1-4])(.*?)\${2}/$2<\/font>/gs; # --- The tag matching stuff was modified so that it would # --- not mistakenly match foo as links. s/<a( .*?)>//sgio; s/<\/a( *?)>/<\/A>/sgio; s/<(\/?)font(.*?)>/<$1FONT $2>/sgi; s/<img(.*?)>//sgi; s/\{\{(.*?)\}\}/$1<\/tt>/gs; # ---------------------------------------- attempt to add blockquote s/<(\/?)blockquote>/<$1BLOCKQUOTE>/sgi; # ---------------------------------------- attempt to add spacing s/&nbsp\;/\ \;/gs; # ---------------------------------------- attempt to add interesting marks s/&dagger\;/\&dagger\;/gs; s/&Dagger\;/\&Dagger\;/gs; # ---------------------------------------- attempt to add class support s/<span(.*?)>//sgi; s/<\/span( *?)>/<\/SPAN>/sgi; s/<div(.*?)>/
/sgi; s/<\/div( *?)>/<\/DIV>/sgi; # ---------------------------------------- attempt to add form support s/<(\/?)form(.*?)>/<$1FORM $2>/sgi; s/<(\/?)input(.*?)>/<$1input $2>/sgi; s/<(\/?)select(.*?)>/<$1SELECT $2>/sgi; s/<(\/?)option(.*?)>/<$1OPTION $2>/sgi; s/<(\/?)textarea(.*?)>/<$1TEXTAREA $2>/sgi; # ---------------------------------------- attempt to add table support s/<(\/?)table(.*?)>/<$1TABLE $2>/sgi; # --- The tag matching was modified so that it would not # --- mistakenly match bar s/<tr(( .*?)?)>//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*$/

/ && ($code = '...'); s/^(\t+)(.+):\t/

$2
/ && ($outtext=$outtext.&ProcessCode(DL, length $1)); s/^(\t+)\*/
  • / && ($outtext=$outtext.&ProcessCode(UL, length $1)); s/^(\t+)\d+\.?/
  • / && ($outtext=$outtext.&ProcessCode(OL, length $1)); /^\s/ && ($outtext=$outtext.&ProcessCode(PRE, 1)); $code || ($outtext=$outtext.&ProcessCode("", 0)); # s/'{3}(.*)'{3}/$1<\/strong>/g; # s/'{2}(.*)'{2}/$1<\/em>/g; s/##([1-9])(.*?)##/$2<\/H$1>/g; # s/##1(.*?)##/

    $1<\/H1>/g; # s/##2(.*?)##/

    $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 = < EOF &ExtractColor; &RequestLock; %old = &RetrievePage($title); if ( $old{worldview} eq "no" && $old{vpwd} ne "none" && $vpwd ne $MasterViewPass && $old{vpwd} ne $vpwd ) { $options = &FormOptions; print < $title EOF print $meta; print $HeaderAddInfo; print &BodyTag; print <

    Password Required

    The page you are trying to access is password protected.

    Please enter the appropriate password in the text area below
    to view the page.

    $options

    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 < $title EOF print $meta; print $HeaderAddInfo; print &BodyTag; print &ProcessBodyText($title,$_,1,%old); #print &RecursePage($title,0,$_); #print &bob($_); print "\n"; } # -------------------------------------------------------- HandleBrowse sub HandleAccess { $title = $CookedInput{access}; $title =~ /^$LinkPattern$/ || &AbortScript("access: improper name: $title"); &ExtractColor; %old = &RetrievePage($title); print < Access: $title EOF print $meta; print $HeaderAddInfo; print &BodyTag; 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 EOF print $meta; print $HeaderAddInfo; print &BodyTag; print <

    Edit Password Required

    The page you are trying to access is password protected.

    Please enter the appropriate password in the text area below
    to edit the page.

    $options

    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 < Edit $note$title EOF print $meta; print $HeaderAddInfo; print &BodyTag; print < $options

    $note$title

    Back to     $backtitle (quit without changes)


    I can't type tabs. Please ConvertSpacesToTabs for me when I save.

    GoodStyle tips for editing.
    EditLinks to other web servers.
    EOF # Optional "copy" block print <EditCopy from previous author.
    EOF # Continue main form body print <

    Select the PageTemplate for this page: $options
    EOF # end of form and routine. } # -------------------------------------------------------- HandleEdit sub HandleJournalEdit { $title = $CookedInput{journal} ; $title =~ /^$LinkPattern$/ || &AbortScript("edit: improper name: $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 = "\n"; if ($CookedInput{vpwd}) { $options = $options."\n"; } if ($CookedInput{epwd}) { $options = $options."\n"; } if ( $old{worldwrite} eq "no" && $old{epwd} && $old{epwd} ne "none" && $epwd ne $MasterEditPass && $old{epwd} ne $epwd ) { print < Edit password required EOF print $meta; print $HeaderAddInfo; print &BodyTag ; print <

    Edit Password Required

    The page you are trying to access is password protected.

    Please enter the appropriate password in the text area below
    to edit the page.

    $options

    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 < Edit $note$title EOF print $meta; print $HeaderAddInfo; print &BodyTag ; print < $options

    $note$title

    Back to $title (quit without changes)


    I can't type tabs. Please ConvertSpacesToTabs for me when I save.

    GoodStyle tips for editing.
    EditLinks to other web servers.
    EOF # Optional "copy" block print <EditCopy from previous author.
    EOF # Continue main form body print <

    Select the PageTemplate for this page: $options
    EOF # end of form and routine. } # -------------------------------------------------------- HandleJournalEdit sub HandleLinks { $title = $CookedInput{links}; $title =~ /^$LinkPattern$/ || &AbortScript("link: improper name: $title"); &ExtractColor; %old = &RetrievePage($title); print < $title Links EOF print $meta; print $HeaderAddInfo; print &BodyTag ; print <

    $title Links

    [1]
    [2]
    [3]
    [4]
    [5]
    [6]
    [7]
    [8]

    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 < Search $results EOF print $meta; print $HeaderAddInfo; print &BodyTag; print "

    Search $results

    "; while (($key, $value) = each %db){ $n++; %rec = split($FieldSeparator, $value); if ($key =~/\b\w*($pat)\w*\b/i || $rec{text} =~ /\b\w*($pat)\w*\b/i){ $m++; print "$key<\/a> . . . . . . $&
    \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="

    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= < $SERVER_NAME Wiki RSS Syndication -- Recent Changes<\/title> <description>Page edits for $SERVER_NAME result in new items. <\/description> <link>$ScriptUrl<\/link> <!-- next item marker --> <\/channel> <\/rss> EOF } open (RSS, ">$Rss.xml"); ## Delete previous occurances of item $rssdata=~ s/\n<item>\n<title>$title<\/title>.*?<\/item>\n//gsx; ## Insert new occurance at marker $rssdata=~ s/<!-- next item marker -->/<!-- next item marker -->\n<item>\n<title>$title<\/title>\n<guid isPermaLink=\"false\">$title:$DateToday:$TimeStamp<\/guid>\n<description>$title edited on $DateToday at $TimeStamp<\/description>\n<link>$ScriptUrl?$title<\/link>\n<\/item>\n/; print RSS $rssdata; close RSS; print <<EOF ; <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"> <HTML> <head> <title>Thanks for $title Edits EOF print $meta; print $HeaderAddInfo; print &BodyTag; print < $thanksText

    $backstring

    p.s. Be sure to Reload your old pages.
    EOF } # -------------------------------------------------------- HandlePost sub HandleSpecial { $action= $CookedInput{special}; $title = $CookedInput{$action}; &ExtractColor; print < $action: $title EOF print $meta; print $HeaderAddInfo; print &BodyTag; if ( exists $config{"SPECIAL$action"} ) { print "\n"; eval $config{"SPECIAL$action"}; print "\n"; } else { print "<<UNKNOWN SYMBOL SPECIAL$action>>"; } print < EOF } # -------------------------------------------------------- HandleSpecial sub DumpBinding { local(*dict) = @_; print "

    \n"; for (keys(%dict)){print "
    $_
    $dict{$_}\n";} 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 Results EOF print $meta; print $HeaderAddInfo; print &BodyTag; print <File Upload Results 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.

    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.

    Upload Status Information

    EOF

      $entity->dump_skeleton;
      print <
EOF
    }
}
# &DumpBinding(*CookedInput);
# &DumpBinding(*old);
# &DumpBinding(*ENV);
# --------------------------------------------------------  WikiInHyperPerl