Tetra-WebBBS Debugger 6.10

Contents of /home/zoetecnocampoco/public_html/cgi-bin/bbs/lib/webbbs_basic.pl

    1- #<<<
    2- #######################################
    3- #    ---  Tetra-WebBBS  --- 
    4- # By:             tetrabb.com
    5- # Version:        6.10
    6- # Last modified:  2009-11-01
    7- # Copyright (c)   2006-2009
    8- # Website:        http://tetrabb.com
    9- # For more details see license.txt
   10- #
   11- # Core script:    webbbs_basic.pl
   12- # Authors:        Rainer Libowski
   13- #                 Tarty
   14- # Derived from code by Darryl Burgdorf
   15- #######################################
   16- #>>>
   17- 
   18- our $VERSION = "6.10";
   19- 
   20- our %Cookie_Encode_Chars = ( '\%', '%25', '\+',       '%2B', '\;',   '%3B', '\,',   '%2C', '\=',   '%3D', '\&',   '%26', '\:\:', '%3A%3A', '\s',   '+' );
   21- our %Cookie_Decode_Chars = ( '\+', ' ',   '\%3A\%3A', '::',  '\%26', '&',   '\%3D', '=',   '\%2C', ',',   '\%3B', ';',   '\%2B', '+',      '\%25', '%' );
   22- 
   23- use TetraBB::Main 0.30;
   24- require 'tbb.pl';
   25- &TBB::tbb_startup();
   26- 
   27- use TetraBB::Read5x 0.39;
   28- our $read5x = TetraBB::Read5x->new();
   29- use Fcntl qw(:flock O_RDWR O_RDONLY O_WRONLY O_CREAT);
   30- use Symbol;
   31- 
   32- %main::dispatch_old_public = (
   33- 'index' => sub { require 'webbbs_index.pl'; },
   34- 
   35- 'read' => sub { require 'webbbs_read.pl'; &startup_read; },
   36- 'form' => sub { require 'webbbs_form.pl'; &PostForm; },
   37- 'post' => sub { require 'webbbs_post.pl'; },
   38- 
   39- 'profile'  => sub { require 'webbbs_profile.pl'; &startup_profile; &UserProfile; },
   40- 'profiles' => sub { require 'webbbs_profile.pl'; &startup_profile; &ListProfiles; },
   41- 'profilesave' => sub { require 'webbbs_profile.pl'; &startup_md_profilesave; },
   42- 'profileedit' => sub { require 'webbbs_profile.pl'; &startup_profile; &EditProfile; },
   43- 
   44- 'delete'      => sub { require 'webbbs_misc.pl'; &startup_misc; &startup_md_delete; },
   45- 'addresslist' => sub { require 'webbbs_misc.pl'; &startup_misc; &UpdateAddressList; },
   46- 'reconfigure' => sub { require 'webbbs_misc.pl'; &startup_misc; &Reconfigure; },
   47- 'search' => sub {
   48- return if ( $main::tbb->{'conf'}->{'search'}->{'enable'} );
   49- require 'webbbs_misc.pl';
   50- &startup_misc;
   51- &Search;
   52- },
   53- 'qsrch'       => sub { require 'webbbs_index.pl'; &quick_search; },
   54- 'reconfigure' => sub { require 'webbbs_misc.pl';  &startup_misc; &Reconfigure; },
   55- 'qpref'       => sub { require 'webbbs_share.pl'; &quick_prefs; },
   56- 'subscribe'   => sub { require 'webbbs_misc.pl';  &startup_misc; &Subscribe; },
   57- 'topstats' => sub {
   58- return if ( !( $TopNPosters > 0 ) );
   59- require 'webbbs_stats.pl';
   60- &TopStats;
   61- },
   62- );
   63- 
   64- sub Startup {
   65- $version = $main::VERSION;
   66- if ( ( -e $data_basedir . '/access.lock' ) && ( !$BypassLock ) ) {
   67- $TopNavbarNoPrint = 1;
   68- $text{'9999'} = '';
   69- print "Content-type: text/html\n\n";
   70- &Error("9900");
   71- exit;
   72- }
   73- 
   74- if ($printbenchmark) {
   75- use Benchmark;
   76- $t0 = new Benchmark;
   77- }
   78- 
   79- if ( !$AdminRun ) {
   80- &reconfigure_registered_users();
   81- }
   82- &accesscontrol();
   83- if ($browsable_archive) {
   84- &reconfigure_browsable_archive();
   85- }
   86- 
   87- umask(0111);
   88- 
   89- &TBB::dispatch($tbb);
   90- 
   91- $UseFrames = $AllowFramesChoice = '';
   92- $BBSFrame = "_parent";
   93- $WelcomePage = "";
   94- 
   95- &parse_basic();
   96- 
   97- unless ($AllowProfiles) { $UserProfileDir = ''; }
   98- unless ($AllowProfilePicsUpload) {
   99- $UserProfilePicsDir = $UserProfilePicsURL = '';
  100- }
  101- ( $SSIvirtual, $SSIfile, $PseudoQS ) = (&FindSpecifics);
  102- 
  103- unless ( $ENV{'QUERY_STRING'} ) {
  104- $ENV{'QUERY_STRING'} = $PseudoQS;
  105- $ENV{'QUERY_STRING'} =~ s/\//=/g;
  106- $ENV{'QUERY_STRING'} =~ s/^=*//g;
  107- }
  108- if ( $ARGV[0] && !( $ENV{'QUERY_STRING'} ) ) {
  109- $ENV{'QUERY_STRING'} = $ARGV[0];
  110- $SkipHF              = 1;
  111- $is_CommandLineCall  = 1;
  112- }
  113- 
  114- if ( ( $ENV{'QUERY_STRING'} =~ s/(;|\/)?(no)?frames(;|\/)?//gi )
  115-      || (    ( !$main::tbb->{'get'}->{'md'} )
  116-           && ( $ENV{'QUERY_STRING'} =~ /(read|rev|review)=\d+/ig ) )
  117-     )
  118- {
  119- &redirect_5x();
  120- }
  121- 
  122- if ( $main::tbb->{'get'}->{'page'} ) {
  123- $thispage = $main::tbb->{'get'}->{'page'};
  124- }
  125- if ( !$main::tbb->{'get'}->{'md'} ) {
  126- $main::tbb->{'get'}->{'md'}   = 'index';
  127- $main::tbb->{'get'}->{'page'} = 1;
  128- }
  129- elsif ( $ENV{'QUERY_STRING'} =~ /^quickinfo/i ) {
  130- $main::tbb->{'get'}->{'md'} = 'index';
  131- }
  132- 
  133- if ( defined $dispatch_old_public{ $tbb->{'get'}->{'md'} } ) {
  134- $dispatch_old_public{ $tbb->{'get'}->{'md'} }->();
  135- return;
  136- }
  137- 
  138- if ( $ENV{'REQUEST_METHOD'} =~ /post/i ) {
  139- $tbb->send_error_plain( "1600", "1601", '1700' );
  140- exit;
  141- }
  142- $tbb->send_error_plain( "9910", "9912", 'locwbas_1000' );
  143- exit;
  144- } ## end sub Startup
  145- 
  146- sub accesscontrol {
  147- if (    $force_domain
  148-      && $ENV{'HTTP_HOST'}
  149-      && ( $force_domain ne $ENV{'HTTP_HOST'} ) )
  150- {
  151- my ( $qs0, $qs1, $qs2 );
  152- if ($SearchFriendlyURLs) { $qs0 = $qs1 = $qs2 = '/'; }
  153- else { $qs0 = '?'; $qs1 = ';'; $qs2 = '='; }
  154- my $redirect = 'http://' . $force_domain . $ENV{'SCRIPT_NAME'} . $qs0;
  155- if ( ( !$SearchFriendlyURLs ) && $ENV{'QUERY_STRING'} ) {
  156- $redirect .= $ENV{'QUERY_STRING'};
  157- }
  158- else {
  159- my %query_items = %{ $tbb->{'get'} };
  160- for ( 'page', 'md', 'id' ) {
  161- next unless $query_items{$_};
  162- $redirect .= $_ . $qs2 . $query_items{$_} . $qs1;
  163- delete $query_items{$_};
  164- }
  165- for ( sort keys %query_items ) {
  166- next unless $query_items{$_};
  167- $redirect .= $_ . $qs2 . $query_items{$_} . $qs1;
  168- }
  169- }
  170- 
  171- print "Content-type: text/html\n";
  172- print "Status: 301 Moved Permanently\n";
  173- print "Location: $redirect\n\n";
  174- exit;
  175- }
  176- 
  177- $harvester_list   = 'bullseye|cherrypicker|crescent|dts agent|emailcollector|emailsiphon|emailwolf|extractor|larbin|microsoft url|mozilla/3.mozilla/2.01|newt|nicerspro|panscient|webbandit|brutus';
  178- $download_list    = 'da \d|dnload|download|fetch|flashget|ftp|getright|gozilla|jetcar|leach|leech|webreaper';
  179- $linkchecker_list = 'analyze|check|link|netmechanic|netmind|powermarks|redalert|tooter|validat|verif|walk';
  180- $offline_list     = 'avantgo|batch|copier|httrack|msiecrawler|msproxy|netattache|netscape-proxy|offline|spacebison|teleport|webcapture|webzip';
  181- $spider_list
  182-     = 'aport|archive|ask jeeves|aspseek|baidu|behold|borg|bot|catch|crawl|digger|elitesys|enfish|esense|euroseek|ferret|googlebot|grab|griffon|grub-client|gulliver|harvest|htdig|houxou|hubat|hunt|infoseek|internetseer|java|larbin|leia|lwp-|lwp:|mantraagent|mapper|mata hari|mediapartners-google|mercator|mj12bot|netants|perl|quest|reader|reaper|roamer|rover|scooter|slurp|sogou|snatch|spider|spinne|spyder|sweep|t-h-u-n-d-e-r-s-t-o-n-e|twiceler|ultraseek|url|utopy|voilabot|webcollage|webster pro|webwhacker|wfarc|wget|whatuseek|yandex';
  183- 
  184- $is_bot = $is_spider = 0;
  185- if ( $ENV{'HTTP_USER_AGENT'} =~ m#$spider_list#oi ) {
  186- $is_spider        = 1;
  187- $PaginationLength = 30;
  188- 
  189- if ( $tbb->{'get'}->{'page'}
  190-      && ( $tbb->{'get'}->{'md'} eq 'read' ) )
  191- {
  192- my ( $qs0, $qs1, $qs2 );
  193- if ($SearchFriendlyURLs) { $qs0 = $qs1 = $qs2 = '/'; }
  194- else { $qs0 = '?'; $qs1 = ';'; $qs2 = '='; }
  195- my $redirect    = $ENV{'SCRIPT_NAME'} . $qs0;
  196- my %query_items = %{ $tbb->{'get'} };
  197- if ( $query_items{'page'} ) {
  198- delete $query_items{'page'};
  199- }
  200- for ( 'md', 'id' ) {
  201- next unless $query_items{$_};
  202- $redirect .= $_ . $qs2 . $query_items{$_} . $qs1;
  203- delete $query_items{$_};
  204- }
  205- for ( sort keys %query_items ) {
  206- next unless $query_items{$_};
  207- $redirect .= $_ . $qs2 . $query_items{$_} . $qs1;
  208- }
  209- print "Content-type: text/html\n";
  210- print "Status: 301 Moved Permanently\n";
  211- print "Location: $redirect\n\n";
  212- exit;
  213- }
  214- }
  215- 
  216- if (    ($is_spider)
  217-      || ( $ENV{'HTTP_USER_AGENT'} =~ m#$harvester_list#oi )
  218-      || ( $ENV{'HTTP_USER_AGENT'} =~ m#$download_list#oi )
  219-      || ( $ENV{'HTTP_USER_AGENT'} =~ m#$linkchecker_list#oi )
  220-      || ( $ENV{'HTTP_USER_AGENT'} =~ m#$offline_list#oi ) )
  221- {
  222- if ( !$is_spider ) {
  223- $is_bot = 1;
  224- }
  225- if ( !$ENV{'HTTP_COOKIE'} ) {
  226- $AllowTroubleTicket = 0;
  227- }
  228- if ($is_spider) {
  229- if ( $browsable_archive || $ArchiveOnly ) {
  230- $browsable_archive = 2;
  231- $teaser_ajax       = 0;
  232- }
  233- else {
  234- if ($SE_no_teaser) {
  235- $browsable_archive = 2;
  236- $teaser_ajax       = 0;
  237- }
  238- else {
  239- $browsable_archive = 1;
  240- }
  241- }
  242- }
  243- else {
  244- $teaser_ajax       = 0;
  245- $browsable_archive = 2;
  246- }
  247- $IndPaginateHeadlineNoPrint = 1;
  248- $HideAdminEmail             = 1;
  249- $CancelFrames               = 1;
  250- $UseFrames                  = '';
  251- $DisplayViews               = 0;
  252- $DisplayProfileEmail        = 0;
  253- $AdminRun                   = 0;
  254- $TopNPosters                = 0;
  255- $Moderated                  = 1;
  256- $AllowReportAbuse           = 0;
  257- $AllowTellAFriend           = 0;
  258- $NewProfilesModerated       = 1;
  259- %QuickPrefs                 = ();
  260- $AllowSearch                = 0;
  261- $AllowQuickSearch           = 0;
  262- if ( $SE_no_profiles || $is_bot ) {
  263- $ListProfiles       = 0;
  264- $AllowProfiles      = 0;
  265- $UserProfileDir     = '';
  266- $UserProfilePicsDir = '';
  267- $UserProfilePicsURL = '';
  268- }
  269- }
  270- if ( ( $BannedIPsFile || $BanUnresolved ) && ( $BanLevel == 2 ) ) {
  271- if ($ResolveIPs) {
  272- if ( ( $ENV{'REMOTE_ADDR'} =~ /^\d+\.\d+\.\d+\.\d+$/ )
  273-      && ( !( $ENV{'REMOTE_HOST'} )
  274-           || ( $ENV{'REMOTE_HOST'} =~ /^\d+\.\d+\.\d+\.\d+$/ ) )
  275-     )
  276- {
  277- @domainbytes = split( /\./, $ENV{'REMOTE_ADDR'} );
  278- $packaddr = pack( "C4", @domainbytes );
  279- $resolvedip = ( gethostbyaddr( $packaddr, 2 ) )[0];
  280- unless ( $resolvedip =~ /^[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})$/ ) {
  281- $resolvedip = "";
  282- }
  283- if ($resolvedip) {
  284- $ENV{'REMOTE_HOST'} = $resolvedip;
  285- }
  286- }
  287- }
  288- unless ( $ENV{'REMOTE_HOST'} ) {
  289- $ENV{'REMOTE_HOST'} = $ENV{'REMOTE_ADDR'};
  290- }
  291- if ( -s $BannedIPsFile ) {
  292- open( BANNED, "$BannedIPsFile" );
  293- @bannedips = <BANNED>;
  294- close(BANNED);
  295- foreach $bannedip (@bannedips) {
  296- chomp($bannedip);
  297- $bannedip =~ s/^([^\s]*)\s.*$/$1/g;
  298- next if ( length($bannedip) < 2 );
  299- if (    ( $ENV{'REMOTE_HOST'} =~ /$bannedip/i )
  300-      || ( $ENV{'REMOTE_ADDR'} =~ /$bannedip/i ) )
  301- {
  302- $tbb->send_error_plain( $main::text{'9522'}, $main::text{'9523'} );
  303- exit;
  304- }
  305- }
  306- undef @bannedips;
  307- }
  308- if ($BanUnresolved) {
  309- if ( $ENV{'REMOTE_HOST'} =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
  310- $tbb->send_error_plain( $main::text{'9522'}, $main::text{'9523'} );
  311- exit;
  312- }
  313- }
  314- }
  315- if ( ( $ENV{'REQUEST_METHOD'} =~ /post/i ) && ( !$AdminRun ) ) {
  316- my $trapped = 0;
  317- if ( ($UseCookies) && ( !$ENV{'HTTP_COOKIE'} ) ) {
  318- for ( 'qsrch', 'qpref' ) {
  319- if ( $tbb->{'get'}->{'md'} eq $_ ) {
  320- $trapped = 1;
  321- }
  322- }
  323- if ( ( $tbb->{'post'}->{'Keywords'} ) || ( $tbb->{'post'}->{'Author'} ) ) {
  324- $trapped = 1;
  325- }
  326- if ( $tbb->{'post'}->{'ResetConfig'} ) {
  327- $trapped = 1;
  328- }
  329- 
  330- }
  331- if ($trapped) {
  332- $tbb->{'conf'}->{'main'}->{'BBSquery'} = '?';
  333- $tbb->{'conf'}->{'text'} = \%main::text;
  334- $tbb->send_error_plain( $main::text{'1600'}, $main::text{'1601'}, $main::text{'1700'} );
  335- exit;
  336- }
  337- }
  338- } ## end sub accesscontrol
  339- 
  340- sub reconfigure_browsable_archive {
  341- $IndTopinfNoPrint  = 1;
  342- $ArchiveOnly       = 0;
  343- $UseCookies        = 0;
  344- $AllowUserPrefs    = 0;
  345- $AllowNewThreads   = 0;
  346- $AllowResponses    = 0;
  347- $AllowUserDeletion = 0;
  348- $ShowPosterIP      = 0;
  349- $DisplayIPs        = 0;
  350- $email_list        = 0;
  351- $DisplayEmail      = 0;
  352- $BlindEmail        = 0;
  353- $AllowFramesChoice = '';
  354- 
  355- if ( $browsable_archive == 2 ) {
  356- $teaser_length = 0;
  357- }
  358- 
  359- if ($ArchiveOnly) {
  360- $AllowUserPrefs = 0;
  361- $UseCookies     = 0;
  362- }
  363- 
  364- } ## end sub reconfigure_browsable_archive
  365- 
  366- sub reconfigure_registered_users {
  367- my $username = $tbb->{'session'}->{'board_user'}->{'name'};
  368- if ( $Cookies{'name'} ) {
  369- my $verified_ref = $tbb->{'db'}->verify_exists_data( 'type' => 'profile',
  370-                                                      'id'   => $username, );
  371- if ($verified_ref) {
  372- eval '&main::registered_users();';
  373- $tbb->{'session'}->{'board_user'}->{'is_registered'} = 1;
  374- }
  375- }
  376- } ## end sub reconfigure_registered_users
  377- 
  378- sub redirect_5x {
  379- my $redirect = $ENV{'SCRIPT_NAME'};
  380- my ( $mode, $id, $pagenum );
  381- if (    ( $ENV{'QUERY_STRING'} =~ /read=(\d+)/ )
  382-      || ( $ENV{'QUERY_STRING'} =~ /rev=(\d+)/ )
  383-      || ( $ENV{'QUERY_STRING'} =~ /review=(\d+)/ ) )
  384- {
  385- $mode = 'read';
  386- $id   = $1;
  387- }
  388- elsif ( $ENV{'QUERY_STRING'} !~ /=/ ) {
  389- $mode = $ENV{'QUERY_STRING'};
  390- }
  391- else {
  392- $mode = 'index';
  393- }
  394- my ( $qs0, $qs1, $qs2 );
  395- if ($SearchFriendlyURLs) { $qs0 = $qs1 = $qs2 = '/'; }
  396- else { $qs0 = '?'; $qs1 = ';'; $qs2 = '='; }
  397- if ($mode) {
  398- $redirect .= $qs0 . 'md' . $qs2 . $mode;
  399- }
  400- if ($id) {
  401- $redirect .= $qs1 . 'id' . $qs2 . $id;
  402- }
  403- if ( $main::tbb->{'get'}->{'page'}
  404-      && ( !$is_spider ) )
  405- {
  406- $redirect .= $qs1 . 'page' . $qs2 . $main::tbb->{'get'}->{'page'};
  407- }
  408- 
  409- print "Content-type: text/html\n";
  410- print "Status: 301 Moved Permanently\n";
  411- print "Location: $redirect\n\n";
  412- exit;
  413- 
  414- } ## end sub redirect_5x
  415- 
  416- sub Parse_Form {
  417- if ( ( !$post ) && ( !$get ) ) { &parse_basic(); }
  418- %FORM       = %{$post};
  419- $RogueSpace = chr(160);
  420- my @keys = keys %FORM;
  421- while (@keys) {
  422- my $key = shift @keys;
  423- $FORM{$key} =~ s/\cM\n*/\n/g;
  424- $FORM{$key} =~ s/$RogueSpace/ /g;
  425- next
  426-     if (    ( $key eq "bembody" )
  427-          || ( $key eq "bemsubject" )
  428-          || ( $key eq "listitems" ) );
  429- $FORM{$key} =~ s/\n/ /go;
  430- $FORM{$key} =~ s/\s+/ /go;
  431- $FORM{$key} =~ s/^\s+//go;
  432- $FORM{$key} =~ s/\s+$//go;
  433- }
  434- for ( 'bembody', 'bemsubject' ) {
  435- $FORM{$_} =~ s/<!--([^>]|\n)*-->/ /go;
  436- $FORM{$_} =~ s/<([^>]|\n)*(>|$)/ /go;
  437- $FORM{$_} =~ s/\&/\&\;/go;
  438- $FORM{$_} =~ s/"/\"\;/go;
  439- $FORM{$_} =~ s/</\<\;/go;
  440- $FORM{$_} =~ s/>/\>\;/go;
  441- }
  442- if ( $FORM{'listitems'} ) {
  443- $FORM{$key} =~ s/^\s+//go;
  444- $FORM{$key} =~ s/\s+$//go;
  445- @listitems = split( /\n/, $FORM{'listitems'} );
  446- }
  447- for ( 'delete', 'id' ) {
  448- $FORM{$_} =~ s/\0/ /g;
  449- }
  450- 
  451- } ## end sub Parse_Form
  452- 
  453- sub Initialize_Data {
  454- 
  455- $dblock_locked    = 0;
  456- $countlock_locked = 0;
  457- 
  458- if ( !$SFU_word_delimiter ) {
  459- $SFU_word_delimiter = $tbb->{'conf'}->{'main'}->{'SFU_word_delimiter'} = '-';
  460- }
  461- if ( !$SFU_base_chars ) {
  462- $SFU_base_chars = $tbb->{'conf'}->{'main'}->{'SFU_base_chars'} = 'a-z0-9';
  463- }
  464- if ( $SearchFriendlyURLs
  465-      && ( !$SFU_pseudo_fileextension ) )
  466- {
  467- $SFU_pseudo_fileextension = $tbb->{'conf'}->{'main'}->{'SFU_pseudo_fileextension'} = '/';
  468- }
  469- elsif ( !$SearchFriendlyURLs ) {
  470- $SFU_pseudo_fileextension = $tbb->{'conf'}->{'main'}->{'SFU_pseudo_fileextension'} = '';
  471- }
  472- 
  473- $time        = time;
  474- $todaydate   = $time;
  475- $rebuildflag = 0;
  476- 
  477- unless ($SecLineDelim) {
  478- $SecLineDelim = ( $IndexEntryLines == 1 ) ? ' -- ' : '<br>';
  479- }
  480- unless ($DateDelim) {
  481- $DateDelim = ' -- ';
  482- }
  483- $gb_msg_cnt = 0;
  484- unless ($InputColumns)        { $InputColumns = 80; }
  485- elsif  ( $InputColumns < 25 ) { $InputColumns = 25; }
  486- unless ($InputRows)           { $InputRows    = 15; }
  487- elsif  ( $InputRows < 5 )     { $InputRows    = 5; }
  488- $InputLength       = int( $InputColumns / 2 );
  489- $TotalMessages     = 0;
  490- $DisplayedMessages = 0;
  491- @messages          = ();
  492- @sortedmessages    = ();
  493- @keywordmatches    = ();
  494- 
  495- $datematchstring = "\\w\\.\\-\\'\\s\\(\\)";
  496- 
  497- if    ( $SessionTime < 5 )   { $SessionTime = 30; }
  498- elsif ( $SessionTime > 120 ) { $SessionTime = 30; }
  499- $SessionTime = $SessionTime * 60;
  500- 
  501- $maillist_link = "<a href='mailto:$maillist_address'>";
  502- $maillist_link .= "$maillist_address<\/A>";
  503- $DestinationURL = ($AdminRun) ? $adminurl : $cgiurl;
  504- $emailboardname = $boardname;
  505- $emailboardname =~ s/\>\;/>/go;
  506- $emailboardname =~ s/\<\;/</go;
  507- $emailboardname =~ s/\"\;/"/go;
  508- $emailboardname =~ s/\&\;/\&/go;
  509- my $safe_host = $ENV{HTTP_HOST};
  510- $safe_host =~ s/^(\w{3}\.)?([^\/]+).*?$/$2/;
  511- $longcgiurl =
  512-     ( $cgiurl =~ m!$safe_host/(.*)$!i )
  513-     ? $cgiurl
  514-     : $ROOT_URL . $cgiurl;
  515- $longDestinationURL =
  516-     ( $DestinationURL =~ m!$safe_host/(.*)$!i )
  517-     ? $DestinationURL
  518-     : $ROOT_URL . $DestinationURL;
  519- 
  520- foreach $key ( keys %text ) {
  521- next unless ( $text{$key} =~ /<!--(.*)-->/go );
  522- $text{$key} =~ s/<!--boardname-->/$emailboardname/go;
  523- $text{$key} =~ s/<!--boardurl-->/$longcgiurl/go;
  524- $text{$key} =~ s/<!--email-->/$maillist_address/go;
  525- $text{$key} =~ s/<!--emaillink-->/$maillist_link/go;
  526- $text{$key} =~ s/<!--NoFramesURL-->/<a href='$longDestinationURL'>/go;
  527- }
  528- 
  529- if    ( $ListBullets == 1 ) { $ul_dl = "ul"; $li_dd = "li"; }
  530- elsif ( $ListBullets == 2 ) { $ul_dl = "ol"; $li_dd = "li"; }
  531- else                        { $ul_dl = "dl"; $li_dd = "dd"; }
  532- unless ($admin_name) { $admin_name = $maillist_address; }
  533- 
  534- if ( ( !$main::is_AjaxCall ) && ( !$is_CommandLineCall ) ) {
  535- print "Content-type: text/html\n";
  536- }
  537- use Fcntl;
  538- 
  539- BEGIN {
  540- @AnyDBM_File::ISA = qw (DB_File GDBM_File SDBM_File ODBM_File NDBM_File);
  541- }
  542- if ( eval "require DB_File" ) { @ISA = ('DB_File'); }
  543- else { use AnyDBM_File; $NotUsingBestDBM = 1; }
  544- 
  545- if ( $AdminRun || $AllowMessageReview ) {
  546- &LockOpen( DBLOCK, "$dir/messagelist.lock" );
  547- &MessageDBMWrite;
  548- }
  549- else {
  550- &MessageDBMRead;
  551- }
  552- if ($index_run) {
  553- %hits = ();
  554- my ( $key, $value );
  555- while ( ( $key, $value ) = each %MessageList ) {
  556- $hits{$key} = int($value);
  557- }
  558- @sortedmessages = ( sort { $a <=> $b } keys %hits );
  559- $TotalMessages  = @sortedmessages;
  560- $lastmessage    = $sortedmessages[ @sortedmessages - 1 ];
  561- $firstmessage   = $sortedmessages[0];
  562- if ($browsable_archive) {
  563- $time = $hits{$lastmessage};
  564- }
  565- }
  566- if ( $FORM{'ListSort'} ) {
  567- if ( $FORM{'ListDisplay'} eq "Guestbook" ) {
  568- if ( $FORM{'ListType'} eq "By Threads" ) {
  569- $FORM{'ListType'} = "Guestbook-Style, Threaded";
  570- }
  571- elsif ( $FORM{'ListType'} eq "Compressed" ) {
  572- $FORM{'ListType'} = "Guestbook-Style, Compressed";
  573- }
  574- elsif ( $FORM{'ListType'} eq "Alphabetically" ) {
  575- $FORM{'ListType'} = "Guestbook-Style, Alphabetically";
  576- }
  577- else {
  578- $FORM{'ListType'} = "Guestbook-Style";
  579- }
  580- }
  581- if (    ( $FORM{'ListType'} =~ /Thread/ )
  582-      || ( $FORM{'ListType'} =~ /Compressed/ ) )
  583- {
  584- $FORM{'ListType'} .= ", $FORM{'ListSort'}"
  585-     if (    ( $FORM{'ListSort'} eq "Reversed" )
  586-          or ( $FORM{'ListSort'} eq "Mixed" )
  587-          or ( $FORM{'ListSort'} eq "UBB" ) );
  588- }
  589- else {
  590- unless ( $FORM{'ListSort'} eq "Standard" ) {
  591- $FORM{'ListType'} .= ", Reversed";
  592- }
  593- }
  594- }
  595- if ( $FORM{'ListTimeB'} && $FORM{'ListType'} && !($AllowUserPrefs) ) { $FORM{'ListTimeA'} = $FORM{'ListTimeB'} = "";
  596- $FORM{'ListType'} = $FORM{'ListSize'} = "";
  597- }
  598- if ( $FORM{'ListTimeB'} ) {
  599- $FORM{'ListTimeA'} = int( $FORM{'ListTimeA'} );
  600- if ( $FORM{'ListTimeA'} < 1 ) { $FORM{'ListTimeA'} = 1; }
  601- $FORM{'ListTime'} = "$FORM{'ListTimeA'} $FORM{'ListTimeB'}";
  602- }
  603- if ( $FORM{'ListSize'} eq "New" ) {
  604- $FORM{'ListTime'} = "New Only";
  605- }
  606- $name = "";
  607- if ( $LockRemoteUser && $ENV{'REMOTE_USER'} ) {
  608- $name = $ENV{'REMOTE_USER'};
  609- }
  610- else {
  611- if ( $FORM{'name'} ) { $name = "$FORM{'name'}"; }
  612- $name = substr( $name, 0, $MaxInputLength );
  613- }
  614- $FORM{'name'} = "";
  615- if ($name) {
  616- $FORM{'name'}    = $name;
  617- $Cookies{'name'} = $name;
  618- }
  619- $email = "";
  620- $FORM{'email'} =~ s/\s//g;
  621- unless (    $FORM{'email'} =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|,|;|\//
  622-          || $FORM{'email'} !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/ )
  623- {
  624- $email = "$FORM{'email'}";
  625- }
  626- if ( length($email) > 100 ) { $email = ""; }
  627- $FORM{'email'} = "";
  628- if ($email) {
  629- $FORM{'email'}    = $email;
  630- $Cookies{'email'} = $email;
  631- }
  632- if ( $main::tbb->{'get'}->{'md'} eq 'profilesave' ) {
  633- unless ($AllowProfileURLs) { $FORM{'url'}      = ""; }
  634- unless ($AllowProfilePics) { $FORM{'imageurl'} = ""; }
  635- }
  636- else {
  637- unless ($AllowURLs) { $FORM{'url'}      = ""; }
  638- unless ($AllowPics) { $FORM{'imageurl'} = ""; }
  639- }
  640- $FORM{'url'}      =~ s/\&\;/\&/g;
  641- $FORM{'url'}      =~ s/\s//g;
  642- $FORM{'imageurl'} =~ s/\&\;/\&/g;
  643- $FORM{'imageurl'} =~ s/\s//g;
  644- unless (    $FORM{'url'} =~ /(\.\.)|(^\.)|(\/\/\.)/
  645-          || $FORM{'url'} !~ /.*\:\/\/.*\..*/ )
  646- {
  647- $message_url = "$FORM{'url'}";
  648- $message_url_title = ( $FORM{'url_title'} ) ? $FORM{'url_title'} : $FORM{'url'};
  649- }
  650- unless (    $FORM{'imageurl'} =~ /(^\.)|(\/\/\.)/
  651-          || $FORM{'imageurl'} !~ /.*\:\/\/.*\..*/
  652-          || $FORM{'imageurl'} =~ /script:/ )
  653- {
  654- $image_url = "$FORM{'imageurl'}";
  655- }
  656- if ( length($message_url) > 250 ) { $message_url         = ""; }
  657- if ( length($image_url) > 250 )   { $image_url           = ""; }
  658- if ($message_url)                 { $Cookies{'linkurl'}  = $message_url; }
  659- if ($message_url_title)           { $Cookies{'linkname'} = $message_url_title; }
  660- if ($image_url)                   { $Cookies{'imageurl'} = $image_url; }
  661- if ( ( $FORM{'newpass1'} ) || ( $FORM{'newpass2'} ) ) {
  662- unless ( $FORM{'newpass1'} eq $FORM{'newpass2'} ) {
  663- &Error( "9602", "9603" );
  664- }
  665- $FORM{'oldpassword'} = $FORM{'password'};
  666- $FORM{'password'}    = $FORM{'newpass1'};
  667- }
  668- if ($CookieReadOnly) { $CookieReadOnly = 0; $CookieAlreadyRead = 1; }
  669- if ( $UseCookies && !($CookieResetNew) ) {
  670- if   ($AdminRun) { &SetAdminCookieData; }
  671- else             { &SetCookieData; }
  672- }
  673- unless (    ( $main::tbb->{'get'}->{'md'} eq 'profilesave' )
  674-          || $AdminRun
  675-          || $AllowMessageReview )
  676- {
  677- if ($name) {
  678- $ProfileCheck = $name;
  679- $ProfileCheck =~ s/[^\w\.\-\']/\+/g;
  680- $ProfileCheck =~ tr/A-Z/a-z/;
  681- if ( $RequireProfile && $RequireEmail ) {
  682- if ( $ProfileCheck
  683-      && ( -e "$UserProfileDir/$ProfileCheck.txt" ) )
  684- {
  685- $email = "";
  686- $Cookies{'email'} = "";
  687- if ( open( FILE, "$UserProfileDir/$ProfileCheck.txt" ) ) {
  688- binmode(FILE);
  689- while (<FILE>) {
  690- if ( $_ =~ /^EMAIL>(.*)/io ) {
  691- $email = $1;
  692- last;
  693- }
  694- }
  695- close(FILE);
  696- if ($email) { $Cookies{'email'} = $email; }
  697- }
  698- else {
  699- &Error( "9110", "9111" );
  700- }
  701- }
  702- }
  703- }
  704- }
  705- if   ($SearchFriendlyURLs) { $QS0 = "/"; $QS1 = "/"; $QS2 = "/"; }
  706- else                       { $QS0 = "?"; $QS1 = ";"; $QS2 = "="; }
  707- 
  708- if ( !$main::version ) { %hits = (); }
  709- 
  710- $UseFrames = "";
  711- $FORM{'UseFrames'} = "No";
  712- if ($SearchFriendlyURLs) {
  713- $main::PROquery =~ s/=|;/\//g;
  714- $BBSquery = "/" . $PROquery;
  715- }
  716- else { $BBSquery = "?" . $PROquery; }
  717- $BBSquery_short = $BBSquery;
  718- if (    ( $main::tbb->{'get'}->{'page'} )
  719-      && ( !$is_spider ) )
  720- {
  721- if   ($SearchFriendlyURLs) { $BBSquery .= 'page/' . $main::tbb->{'get'}->{'page'} . '/'; }
  722- else                       { $BBSquery .= 'page=' . $main::tbb->{'get'}->{'page'} . ';'; }
  723- }
  724- 
  725- $BBStarget    = "";
  726- $BBStargetidx = "";
  727- $BBStargettop = "";
  728- 
  729- unless ( $FORM{'ListTime'} ) { $FORM{'ListTime'} = $DefaultTime; }
  730- unless ( $FORM{'ListTime'} ) { $FORM{'ListTime'} = "2 $text{'0062'}"; }
  731- unless ( $FORM{'ListType'} ) { $FORM{'ListType'} = $DefaultType; }
  732- unless ( $FORM{'ListType'} ) { $FORM{'ListType'} = "Chronologically"; }
  733- if (    ( ( $FORM{'ListType'} =~ /Guestbook/ ) || ( $FORM{'ListType'} =~ /Compress/ ) )
  734-      && ( $IndexEntryLines eq "news" ) )
  735- {
  736- $IndexEntryLines = 2;
  737- }
  738- unless ($DateConfig) {
  739- $DateConfig = "%mo%/%dy%/%YR%, %hr%:%mn% %am%";
  740- }
  741- unless ( $NewOpenCode || $NewCloseCode ) {
  742- $NewOpenCode = "<span class='ind_new'>NEW:</span>";
  743- }
  744- unless ( $AdminOpenCode || $AdminCloseCode ) {
  745- $AdminOpenCode = "<span class='ind_admin'>ADMIN!</span>";
  746- }
  747- unless ($AutoQuoteChar) { $AutoQuoteChar = ":"; }
  748- if ($NM_Telltale) {
  749- $Cleaned_NM_Telltale = $NM_Telltale;
  750- $Cleaned_NM_Telltale =~ s/([\[\]\(\)\\\*\+\?\\\|])/\\$1/g;
  751- }
  752- if ($Link_Telltale) {
  753- $Cleaned_Link_Telltale = $Link_Telltale;
  754- $Cleaned_Link_Telltale =~ s/([\[\]\(\)\\\*\+\?\\\|])/\\$1/g;
  755- }
  756- if ($Pic_Telltale) {
  757- $Cleaned_Pic_Telltale = $Pic_Telltale;
  758- $Cleaned_Pic_Telltale =~ s/([\[\]\(\)\\\*\+\?\\\|])/\\$1/g;
  759- }
  760- } ## end sub Initialize_Data
  761- 
  762- sub PrintDate {
  763- return $_[0] unless ( $_[0] =~ /^\d+$/ );
  764- return $tbb->format_date( 'date' => $_[0] + ( $HourOffset * 3600 ), );
  765- }
  766- 
  767- sub GetCookie {
  768- local ($cookie_name) = @_;
  769- return if $CookieAlreadyRead;
  770- local ( $cookie, $value );
  771- if ( $ENV{'HTTP_COOKIE'} ) {
  772- foreach ( split( /; /, $ENV{'HTTP_COOKIE'} ) ) {
  773- ( $cookie, $value ) = split(/=/);
  774- foreach $char ( '\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25' ) {
  775- $cookie =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  776- $value  =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  777- }
  778- if (    ( $cookie eq "WebBBS Master" )
  779-      || ( $cookie eq $cookie_name ) )
  780- {
  781- $Cookies{$cookie} = $value;
  782- }
  783- last if ( $Cookies{'WebBBS Master'} && $Cookies{$cookie_name} );
  784- }
  785- }
  786- if ( $Cookies{'WebBBS Master'} ) {
  787- foreach ( split( /&/, $Cookies{'WebBBS Master'} ) ) {
  788- ( $cookie, $value ) = split(/::/);
  789- foreach $char ( '\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25' ) {
  790- $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  791- }
  792- $Cookies{$cookie} = $value;
  793- }
  794- }
  795- if ( $Cookies{$cookie_name} ) {
  796- foreach ( split( /&/, $Cookies{$cookie_name} ) ) {
  797- ( $cookie, $value ) = split(/::/);
  798- foreach $char ( '\+', '\%3A\%3A', '\%26', '\%3D', '\%2C', '\%3B', '\%2B', '\%25' ) {
  799- $value =~ s/$char/$Cookie_Decode_Chars{$char}/g;
  800- }
  801- $Cookies{$cookie} = $value;
  802- }
  803- }
  804- delete( $Cookies{'WebBBS Master'} );
  805- delete( $Cookies{$cookie_name} );
  806- if ( $Cookies{'em'} ) { $Cookies{'email'}       = $Cookies{'em'}; }
  807- if ( $Cookies{'iu'} ) { $Cookies{'imageurl'}    = $Cookies{'iu'}; }
  808- if ( $Cookies{'ln'} ) { $Cookies{'linkname'}    = $Cookies{'ln'}; }
  809- if ( $Cookies{'lu'} ) { $Cookies{'linkurl'}     = $Cookies{'lu'}; }
  810- if ( $Cookies{'m1'} ) { $Cookies{'lastmessage'} = $Cookies{'m1'}; }
  811- if ( $Cookies{'m2'} ) { $Cookies{'thismessage'} = $Cookies{'m2'}; }
  812- if ( $Cookies{'nm'} ) { $Cookies{'name'}        = $Cookies{'nm'}; }
  813- if ( $Cookies{'pw'} ) { $Cookies{'password'}    = $Cookies{'pw'}; }
  814- if ( $Cookies{'tm'} ) { $Cookies{'listtime'}    = $Cookies{'tm'}; }
  815- if ( $Cookies{'tp'} ) { $Cookies{'listtype'}    = $Cookies{'tp'}; }
  816- if ( $Cookies{'ts'} ) { $Cookies{'timestamp'}   = $Cookies{'ts'}; }
  817- if ( $Cookies{'v1'} ) { $Cookies{'lastvisit'}   = $Cookies{'v1'}; }
  818- if ( $Cookies{'v2'} ) { $Cookies{'thisvisit'}   = $Cookies{'v2'}; }
  819- if ( $Cookies{'wn'} ) { $Cookies{'wantnotice'}  = $Cookies{'wn'}; }
  820- 
  821- $Cookies{'UseFrames'} = $Cookies{'uf'} = undef;
  822- 
  823- if ($main::AdminRun) {
  824- if (    ( $Cookies{'listtype'} =~ /guestbook/ig )
  825-      || ( $Cookies{'listtype'} =~ /compressed/ig ) )
  826- {
  827- %Saved_Cookies = ( 'listtype' => $Cookies{'listtype'}, );
  828- delete $Cookies{'listtype'};
  829- }
  830- }
  831- 
  832- $CookieAlreadyRead = 1;
  833- return \%Cookies;
  834- } ## end sub GetCookie
  835- 
  836- sub WriteCookie {
  837- $CookiePW = $FORM{'password'};
  838- if ( $FORM{'CookiePW'} eq "No" ) { $CookiePW = ""; }
  839- my $listtype_to_store = $listtype;
  840- if ( $Saved_Cookies{'listtype'} ) {
  841- $listtype_to_store = $Saved_Cookies{'listtype'};
  842- }
  843- 
  844- if ($IsolateCookies) {
  845- if ($SaveLinkInfo) {
  846- &SendCookie( $boardname, 'nm', $name, 'em', $email, 'tp', $listtype_to_store, 'tm', $listtime, 'm1', $lastseen, 'v1', $lastvisit, 'm2', $thisseen, 'v2', $thisvisit, 'ts', $time, 'wn', $Cookies{'wantnotice'}, 'pw', $CookiePW, 'lu', $message_url, 'ln', $message_url_title, 'iu', $image_url, );
  847- }
  848- else {
  849- &SendCookie( $boardname, 'nm', $name, 'em', $email, 'tp', $listtype_to_store, 'tm', $listtime, 'm1', $lastseen, 'v1', $lastvisit, 'm2', $thisseen, 'v2', $thisvisit, 'ts', $time, 'wn', $Cookies{'wantnotice'}, 'pw', $CookiePW, );
  850- }
  851- }
  852- else {
  853- if ($SaveLinkInfo) {
  854- &SendCookie( 'WebBBS Master', 'nm', $name, 'em', $email, 'wn', $Cookies{'wantnotice'}, 'pw', $CookiePW, 'lu', $message_url, 'ln', $message_url_title, 'iu', $image_url );
  855- }
  856- else {
  857- &SendCookie( 'WebBBS Master', 'nm', $name, 'em', $email, 'wn', $Cookies{'wantnotice'}, 'pw', $CookiePW );
  858- }
  859- &SendCookie( $boardname, 'tp', $listtype_to_store, 'tm', $listtime, 'm1', $lastseen, 'v1', $lastvisit, 'm2', $thisseen, 'v2', $thisvisit, 'ts', $time, );
  860- }
  861- if ($main::update_cookie) {
  862- $tbb->{'session'}->{'board_user'}->{'listtime'} = $listtime;
  863- $tbb->{'session'}->{'board_user'}->{'listtype'} = $listtype;
  864- }
  865- 
  866- } ## end sub WriteCookie
  867- 
  868- sub SendCookie {
  869- if ($main::is_AjaxCall) { return; }
  870- local ( $cookie_name, @cookies ) = @_;
  871- local ( $cookie, $value, $cookie_value, $char );
  872- while ( ( $cookie, $value ) = @cookies ) {
  873- next if $cookie eq 'uf';
  874- 
  875- foreach $char ( '\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s' ) {
  876- $cookie =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  877- $value  =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  878- }
  879- if ($cookie_value) {
  880- $cookie_value .= '&' . $cookie . '::' . $value;
  881- }
  882- else {
  883- $cookie_value = $cookie . '::' . $value;
  884- }
  885- shift(@cookies);
  886- shift(@cookies);
  887- }
  888- foreach $char ( '\%', '\+', '\;', '\,', '\=', '\&', '\:\:', '\s' ) {
  889- $cookie_name  =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  890- $cookie_value =~ s/$char/$Cookie_Encode_Chars{$char}/g;
  891- }
  892- print 'Set-Cookie: ', $cookie_name, '=', $cookie_value, ';';
  893- print ' expires=Fri, 31-Dec-2020 00:00:00 GMT;';
  894- print ' path=/;';
  895- print "\n";
  896- } ## end sub SendCookie
  897- 
  898- sub error_on_locking {
  899- $error_on_db_lock = 1;
  900- &Error(@_);
  901- 
  902- }
  903- 
  904- sub Error {
  905- local ( $error_title, $error_text, $error_file ) = @_;
  906- if (    ( $error_title eq "9120" )
  907-      || ( $error_title eq "9200" )
  908-      || ( $error_title eq "9210" )
  909-      || ( $error_title eq "9250" )
  910-      || ( $error_title eq "9500" )
  911-      || ( $error_title eq "9510" ) )
  912- {
  913- $SpellCheckerMeta = 1;
  914- $PreviewForm      = 1;
  915- &Header( $text{$error_title}, $MessageHeaderFile );
  916- &Header2();
  917- }
  918- elsif (    ( $error_title eq "9150" )
  919-         || ( $error_title eq "9122" )
  920-         || ( $error_title eq "9400" )
  921-         || ( $error_title eq "9514" )
  922-         || ( $error_title eq "9516" )
  923-         || ( $error_title eq "9518" )
  924-         || ( $error_title eq "9522" )
  925-         || ( $error_title eq "9530" )
  926-         || ( $error_title eq "9300" )
  927-         || ( $error_title eq "9540" )
  928-         || ( $error_title eq "9600" )
  929-         || ( $error_title eq "9610" )
  930-         || ( $error_title eq "9650" )
  931-         || ( $error_title eq "9652" )
  932-         || ( $error_title eq "9656" )
  933-         || ( $error_title eq "9910" )
  934-         || ( $error_title eq "9900" ) )
  935- {
  936- &Header( $text{$error_title}, $MessageHeaderFile );
  937- &Header2();
  938- }
  939- else {
  940- $RefreshTime = 5 if ( $RefreshTime < 5 );
  941- &Header( $text{$error_title}, $MessageHeaderFile, "refresh" );
  942- &Header2("refresh");
  943- }
  944- if ( $error_title eq "9150" ) {
  945- opendir( MESSAGES, $dir );
  946- @messagedir = readdir(MESSAGES);
  947- closedir(MESSAGES);
  948- foreach $message (@messagedir) {
  949- if ( $message =~ /^messagelist/ ) {
  950- unlink "$dir/$message";
  951- }
  952- }
  953- }
  954- print "<h3>$text{$error_title}</h3>\n", "</div>\n";
  955- if ( length($error_file) > 2 ) {
  956- print "<p style='text-align:center;'>$error_file</p>\n";
  957- }
  958- print "<p>$text{$error_text} $text{'9999'}</p>\n";
  959- return unless ( $error_title < 9700 );
  960- if ($PreviewForm) {
  961- $body = $BodyPreview;
  962- $body =~ s/\& /\&\; /g;
  963- $body =~ s/"/\"\;/g;
  964- $body =~ s/</\<\;/g;
  965- $body =~ s/>/\>\;/g;
  966- if ($realsubject) {
  967- $subject = $realsubject;
  968- $subject =~ s/\& /\&\; /g;
  969- $subject =~ s/"/\"\;/g;
  970- $subject =~ s/</\<\;/g;
  971- $subject =~ s/>/\>\;/g;
  972- }
  973- require 'webbbs_form.pl';
  974- print "<div id='misc_msgform'>\n", $cust{'misc_msgform_s'};
  975- &Print_Form(-1);
  976- print $cust{'misc_msgform_e'}, "\n</div>\n";
  977- }
  978- if ($PreviewForm) { &Footer( $MessageFooterFile, "return", 'nonavbar' ); }
  979- elsif (    ( $error_title eq "9122" )
  980-         || ( $error_title eq "9150" )
  981-         || ( $error_title eq "9522" )
  982-         || ( $error_title eq "9300" )
  983-         || ( $error_title eq "9600" )
  984-         || ( $error_title eq "9610" )
  985-         || ( $error_title eq "9650" )
  986-         || ( $error_title eq "9652" )
  987-         || ( $error_title eq "9656" )
  988-         || ( $error_title eq "9910" ) )
  989- {
  990- &Footer( $MessageFooterFile, '', 'nonavbar' );
  991- }
  992- else { &Footer( $MessageFooterFile, "return", "refresh" ); }
  993- } ## end sub Error
  994- 
  995- sub FindSpecifics {
  996- $ROOT_URL = 'http://' . $ENV{HTTP_HOST};
  997- if ( $ENV{'REQUEST_URI'} =~ /\.(pl|cgi)(\/.*)$/ ) { $PSEUDO_QS = $2; }
  998- if ( $ENV{'SCRIPT_NAME'} && $ENV{'PATH_INFO'} ) {
  999- 
 1000- if ( !$PSEUDO_QS ) {
 1001- $PSEUDO_QS = $ENV{'PATH_INFO'};
 1002- $PSEUDO_QS =~ s/^.*\.(pl|cgi)//i;
 1003- }
 1004- 
 1005- $URI_PATH = $ENV{'SCRIPT_NAME'};
 1006- }
 1007- elsif ( $ENV{'PATH_INFO'} )   { $URI_PATH = $ENV{'PATH_INFO'}; }
 1008- elsif ( $ENV{'SCRIPT_NAME'} ) { $URI_PATH = $ENV{'SCRIPT_NAME'}; }
 1009- $URI_DIR = $URI_PATH;
 1010- $URI_DIR =~ s/^(.*?)\/[^\/\\]*\.[^\.\/]+$/$1/;
 1011- unless ($URI_DIR)                { $URI_DIR  = "/"; }
 1012- if     ( $ENV{'DOCUMENT_ROOT'} ) { $DOC_ROOT = $ENV{'DOCUMENT_ROOT'}; }
 1013- elsif  ( $ENV{'PWD'} )           { $DOC_ROOT = $ENV{'PWD'}; }
 1014- else                             { $DOC_ROOT = $ENV{'PATH_TRANSLATED'}; }
 1015- $DOC_ROOT =~ tr/\\/\//;
 1016- $DOC_ROOT =~ s/^(.+?)$URI_PATH$/$1/;
 1017- $DOC_ROOT =~ s/^(.+?)$URI_DIR(\/)*$/$1/;
 1018- $DOC_ROOT =~ s/^(.+?)\/$/$1/;
 1019- $THIS_DIR = $URI_DIR;
 1020- $THIS_DIR =~ s/^$ROOT_URL//i;
 1021- $THIS_DIR = "$DOC_ROOT/$THIS_DIR";
 1022- $THIS_DIR =~ s/\/\//\//g;
 1023- $THIS_DIR =~ s/\/$//;
 1024- return ( $DOC_ROOT, $THIS_DIR, $PSEUDO_QS );
 1025- } ## end sub FindSpecifics
 1026- 
 1027- sub SSI_Functions {
 1028- my $PASSED = $_[0];
 1029- $PASSED =~ s/<(!--)?\s*TMPL_VAR\s+name\s*=\s*("|')?(.+?)("|')?\s*(--)?>/$cust{$3}/gi;
 1030- if ( $PASSED =~ /<!--/ ) {
 1031- require 'webbbs_ssi.pl';
 1032- &process_SSI($PASSED);
 1033- }
 1034- else { print $PASSED; }
 1035- } ## end sub SSI_Functions
 1036- 
 1037- sub Header {
 1038- local ( $header_title, $header_file, $refresh, $destname ) = @_;
 1039- $header_title =~ s/<([^>]|\n)*(>|$)/ /g;
 1040- if ( $tbb->{'session'}->{'send_cookie'} ) {
 1041- print $tbb->{'session'}->{'send_cookie'} . "\n";
 1042- }
 1043- if ($error_on_db_lock) {
 1044- print "Status: 503 Service unavailable\n";
 1045- print "Retry-after: 86400\n";
 1046- }
 1047- elsif ($DisallowCaching) {
 1048- print "Expires: 0\n";
 1049- print "Cache-Control: no-cache, must-revalidate\n";
 1050- print "Last-Modified: ", gmtime(time), " GMT \n";
 1051- }
 1052- print "\n", $DocType, "\n";
 1053- print "<html><head>\n";
 1054- print "<meta http-equiv='content-type' content='text/html; charset=$CharSet'>\n";
 1055- print "<meta name='robots' content='noindex, nofollow'>\n" if ($AdminRun);
 1056- if ( !( -s $MetaFile ) ) {
 1057- if ( -s $ENV{DOCUMENT_ROOT} . $html_basedir . '/css/webbbs.css' ) {
 1058- print "<link rel='stylesheet' href='" . $html_basedir . "/css/webbbs.css' type='text/css'>\n";
 1059- }
 1060- else {
 1061- print "<style type='text/css'>\n", "body, body * { font-family: verdana, sans-serif; }\n", "</style>\n";
 1062- }
 1063- }
 1064- if ( $RefreshTime
 1065-      && (    ( $refresh eq "refreshalways" )
 1066-           || ( $refresh eq "refresh" ) )
 1067-     )
 1068- {
 1069- print "<META HTTP-EQUIV='Refresh' CONTENT='$RefreshTime; URL=\"$DestinationURL$BBSquery";
 1070- if ( $AdminRun
 1071-      && (    ( $tbb->{'get'}->{'src'} eq 'moderate' )
 1072-           || ( $tbb->{'post'}->{'src'} eq 'moderate' )
 1073-           || $FORM{'ApprovePost'}
 1074-           || $EditApproval )
 1075-     )
 1076- {
 1077- print 'md' . $QS2 . 'parklist' . $QS1 . 'src' . $QS2 . 'moderate;';
 1078- }
 1079- else {
 1080- if ($destname) {
 1081- print 'md' . $QS2 . 'index' . $QS1 . '#m_' . $destname;
 1082- }
 1083- else {
 1084- print 'md' . $QS2 . 'index';
 1085- }
 1086- }
 1087- print "\"'>\n";
 1088- }
 1089- if ( $cust{'title_s'} ) {
 1090- $header_title = $cust{'title_s'} . ' ' . $header_title;
 1091- }
 1092- if ( $cust{'title_e'} ) {
 1093- $header_title .= ' ' . $cust{'title_e'};
 1094- }
 1095- 
 1096- print "<title>$header_title</title>\n";
 1097- 
 1098- if (    !($SkipHF)
 1099-      && $SpellCheckerMeta
 1100-      && $SpellCheckURL )
 1101- {
 1102- $cust{'editor_code'} = "\n<script src='$html_basedir/js/tbb_spellcheck.js' type='text/javascript'>\n</script>\n" . $cust{'editor_code'};
 1103- }
 1104- 
 1105- if ( !($SkipHF) && ( -s $MetaFile ) ) {
 1106- if ( open( HEADLN, "$MetaFile" ) ) {
 1107- binmode(HEADLN);
 1108- while (<HEADLN>) {
 1109- next if ( length($_) < 2 );
 1110- &SSI_Functions($_);
 1111- }
 1112- close(HEADLN);
 1113- }
 1114- }
 1115- 
 1116- print "<script src='" . $tbb->{'conf'}->{'main'}->{'html_basedir'} . "/js/RLajax.base.js' type='text/javascript'>\n</script>\n";
 1117- print "<script src='" . $tbb->{'conf'}->{'main'}->{'html_basedir'} . "/js/tbb_base.js' type='text/javascript'>\n</script>\n";
 1118- if ( $tbb->{'tbb_admin'} ) {
 1119- print "<script src='" . $tbb->{'conf'}->{'main'}->{'html_basedir'} . "/js/tbb_admin.js' type='text/javascript'>\n</script>\n";
 1120- }
 1121- 
 1122- if (    ( $main::tbb->{'get'}->{'md'} eq 'form' )
 1123-      || ( $main::tbb->{'get'}->{'md'} eq 'edit' )
 1124-      || ( $main::tbb->{'get'}->{'md'} eq 'post' )
 1125-      || (    ( !$SepPostFormRead )
 1126-           && ( $main::tbb->{'get'}->{'md'} eq 'read' ) )
 1127-      || (    ( !$SepPostFormIndex )
 1128-           && ( $main::tbb->{'get'}->{'md'} eq 'index' ) )
 1129-      || ($UserEditRun)
 1130-     )
 1131- {
 1132- print $cust{'editor_code'}, "\n";
 1133- }
 1134- 
 1135- print "</head><body $bodyspec>\n";
 1136- if ( !($SkipHF) && ( -s $header_file ) ) {
 1137- if ( open( HEADER, "$header_file" ) ) {
 1138- binmode(HEADER);
 1139- while (<HEADER>) {
 1140- next if ( length($_) < 2 );
 1141- &SSI_Functions($_);
 1142- }
 1143- close(HEADER);
 1144- }
 1145- }
 1146- print "<div id='glob_wrapbbs'>\n";
 1147- } ## end sub Header
 1148- 
 1149- sub Header2 {
 1150- local ( $refresh, $sub_navbar, $subnav_args ) = @_;
 1151- if ( $refresh eq "refresh" ) {
 1152- ( $navbar_top, $navbar_bottom ) =
 1153-     $main::tbb->{'tbb_html'}->get_navbar_HTML( 'sub_navbar'  => $sub_navbar,
 1154-                                                'subnav_args' => $subnav_args, );
 1155- unless ($TopNavbarNoPrint) {
 1156- print "<div id='nb_top'>\n" . $navbar_top . "</div>\n";
 1157- }
 1158- print "<div id='glob_header'>\n", $cust{'glob_header_s'};
 1159- if ($printboardname) {
 1160- print "<h2>$boardname</h2>\n";
 1161- }
 1162- }
 1163- else {
 1164- ( $navbar_top, $navbar_bottom ) =
 1165-     $main::tbb->{'tbb_html'}->get_navbar_HTML( 'sub_navbar'  => $sub_navbar,
 1166-                                                'subnav_args' => $subnav_args, );
 1167- 
 1168- unless ($TopNavbarNoPrint) {
 1169- print "<div id='nb_top'>\n" . $navbar_top . "</div>\n";
 1170- }
 1171- print "<div id='glob_header'>\n", $cust{'glob_header_s'};
 1172- }
 1173- 
 1174- } ## end sub Header2
 1175- 
 1176- sub Footer {
 1177- local ( $footer_file, undef, $refresh ) = @_;
 1178- print "\n<div id='glob_footer'>\n", "<div id='glob_footerbbs'>\n";
 1179- 
 1180- if ( $RefreshTime
 1181-      && (    ( $refresh eq "refreshalways" )
 1182-           || ( $refresh eq "refresh" ) )
 1183-     )
 1184- {
 1185- print '<p>', $text{'0150'}, "</p>\n";
 1186- }
 1187- elsif ( $navbar_bottom && !$BottomNavbarNoPrint && !$refresh ) {
 1188- print "<div id='nb_bttm'>\n" . $navbar_bottom . "</div>\n";
 1189- }
 1190- 
 1191- print $tbb->{'tbb_html'}->get_GF_HTML();
 1192- print "</div></div>\n", "</div>\n";
 1193- 
 1194- if ( !($SkipHF) && ( -s $footer_file ) ) {
 1195- if ( open( FOOTER, "$footer_file" ) ) {
 1196- binmode(FOOTER);
 1197- while (<FOOTER>) {
 1198- next if ( length($_) < 2 );
 1199- &SSI_Functions($_);
 1200- }
 1201- close(FOOTER);
 1202- }
 1203- }
 1204- 
 1205- print "\n</body></html>\n";
 1206- &MessageDBM_close();
 1207- &CountDBM_close();
 1208- reset 'A-Za-z';
 1209- exit;
 1210- } ## end sub Footer
 1211- 
 1212- sub MessageDBM_close {
 1213- 
 1214- if ($messageDBM_isopen) {
 1215- if ( $DBMType == 2 ) {
 1216- dbmclose(%MessageList) || die "dbmclose MessageList failed: $!";
 1217- }
 1218- else {
 1219- untie %MessageList || die "untie MessageList failed: $!";
 1220- }
 1221- $messageDBM_isopen = 0;
 1222- }
 1223- if ( $dblock_locked > 0 ) {
 1224- &LockClose( DBLOCK, "$dir/messagelist.lock" );
 1225- $dblock_locked--;
 1226- }
 1227- 
 1228- } ## end sub MessageDBM_close
 1229- 
 1230- sub MessageDBMRead {
 1231- %MessageList = ();
 1232- my $dbfile = $dir . "/messagelist";
 1233- return unless ( ( -e $dbfile ) || ( -e $dbfile . '.dir' ) || ( -e $dbfile . '.pag' ) );
 1234- if ( $DBMType == 1 ) {
 1235- tie( %MessageList, 'AnyDBM_File', "$dbfile", O_RDONLY, 0666, $DB_HASH )
 1236-     || &Error( "9150", "9151" );
 1237- }
 1238- elsif ( $DBMType == 2 ) {
 1239- dbmopen( %MessageList, "$dbfile", 0666 )
 1240-     || &Error( "9150", "9151" );
 1241- }
 1242- else {
 1243- tie( %MessageList, 'AnyDBM_File', "$dbfile", O_RDONLY, 0666 )
 1244-     || &Error( "9150", "9151" );
 1245- }
 1246- $messageDBM_isopen = 1;
 1247- } ## end sub MessageDBMRead
 1248- 
 1249- sub MessageDBMWrite {
 1250- %MessageList = ();
 1251- my $dbfile = $dir . "/messagelist";
 1252- if ( $DBMType == 1 ) {
 1253- tie( %MessageList, 'AnyDBM_File', "$dbfile", O_RDWR | O_CREAT, 0666, $DB_HASH )
 1254-     || &Error( "9150", "9151" );
 1255- }
 1256- elsif ( $DBMType == 2 ) {
 1257- dbmopen( %MessageList, "$dbfile", 0666 )
 1258-     || &Error( "9150", "9151" );
 1259- }
 1260- else {
 1261- tie( %MessageList, 'AnyDBM_File', "$dbfile", O_RDWR | O_CREAT, 0666 )
 1262-     || &Error( "9150", "9151" );
 1263- }
 1264- $messageDBM_isopen = 1;
 1265- } ## end sub MessageDBMWrite
 1266- 
 1267- sub CountDBM_close {
 1268- if ($countDBM_isopen) {
 1269- if ( $DBMType == 2 ) {
 1270- dbmclose(%CountList) || die "dbmclose CountList failed: $!";
 1271- }
 1272- else {
 1273- untie %CountList || die "untie CountList failed: $!";
 1274- }
 1275- $countDBM_isopen = 0;
 1276- }
 1277- if ( $countlock_locked > 0 ) {
 1278- &LockClose( COUNTLOCK, "$dir/countlist.lock" );
 1279- $countlock_locked--;
 1280- }
 1281- } ## end sub CountDBM_close
 1282- 
 1283- sub CountDBMRead {
 1284- if ($countDBM_isopen) { die "CountDBM is already opened. $!"; }
 1285- %CountList = ();
 1286- my $dbfile = $dir . "/countlist";
 1287- return unless ( -e $dbfile );
 1288- if ( $DBMType == 1 ) {
 1289- tie( %CountList, 'AnyDBM_File', "$dbfile", O_RDONLY, 0666, $DB_HASH );
 1290- }
 1291- elsif ( $DBMType == 2 ) {
 1292- dbmopen( %CountList, "$dir/countlist", 0666 );
 1293- }
 1294- else {
 1295- tie( %CountList, 'AnyDBM_File', "$dbfile", O_RDONLY, 0666 );
 1296- }
 1297- $countDBM_isopen = 1;
 1298- } ## end sub CountDBMRead
 1299- 
 1300- sub CountDBMWrite {
 1301- if ($countDBM_isopen) { die "CountDBM is already opened. $!" }
 1302- %CountList = ();
 1303- my $dbfile = $dir . "/countlist";
 1304- if ( $DBMType == 1 ) {
 1305- tie( %CountList, 'AnyDBM_File', "$dbfile", O_RDWR | O_CREAT, 0666, $DB_HASH )
 1306-     || &Error( "9150", "9151" );
 1307- }
 1308- elsif ( $DBMType == 2 ) {
 1309- dbmopen( %CountList, "$dbfile", 0666 )
 1310-     || &Error( "9150", "9151" );
 1311- }
 1312- else {
 1313- tie( %CountList, 'AnyDBM_File', "$dbfile", O_RDWR | O_CREAT, 0666 )
 1314-     || &Error( "9150", "9151" );
 1315- }
 1316- $countDBM_isopen = 1;
 1317- } ## end sub CountDBMWrite
 1318- 
 1319- sub LockOpen {
 1320- local ( *FILE, $lockfilename, $append ) = @_;
 1321- unless ( -e "$lockfilename" ) {
 1322- open( FILE, ">$lockfilename" );
 1323- print FILE "\n";
 1324- close(FILE);
 1325- }
 1326- if ($append) {
 1327- open( FILE, ">>$lockfilename" )
 1328-     || &error_on_locking( "9400", "9401", $lockfilename );
 1329- }
 1330- else {
 1331- open( FILE, "+<$lockfilename" )
 1332-     || &error_on_locking( "9400", "9401", $lockfilename );
 1333- }
 1334- 
 1335- my $lockresult = $basic->file_lock( *FILE, $lockfilename, undef );
 1336- if ( ( !$lockresult ) && ( $lockfilename =~ /countlist\.lock/ ) ) {
 1337- $NoCountLock = 1;
 1338- }
 1339- elsif ( !$lockresult ) {
 1340- &error_on_locking( "9400", "9401", $lockfilename );
 1341- exit;
 1342- }
 1343- 
 1344- if ( $lockfilename =~ /messagelist\.lock/ ) {
 1345- $dblock_locked++;
 1346- }
 1347- if ( $lockfilename =~ /countlist\.lock/ ) {
 1348- $countlock_locked++;
 1349- }
 1350- } ## end sub LockOpen
 1351- 
 1352- sub LockClose {
 1353- local ( *FILE, $lockfilename ) = @_;
 1354- $basic->file_unlock( *FILE, $lockfilename );
 1355- close(FILE);
 1356- if ( $lockfilename =~ /messagelist\.lock/ ) {
 1357- $dblock_locked--;
 1358- }
 1359- if ( $lockfilename =~ /countlock\.lock/ ) {
 1360- $countlock_locked--;
 1361- }
 1362- } ## end sub LockClose
 1363- 
 1364- sub map_old_vars {
 1365- if ( ( !-d $data_basedir ) || ( !$data_subdir ) ) {
 1366- require 'webbbs_debug.pl';
 1367- &debug_me;
 1368- }
 1369- $dir = $data_basedir . $data_subdir;
 1370- unless ($cgiurl)       { $cgiurl       = $ENV{SCRIPT_NAME}; }
 1371- unless ($html_basedir) { $html_basedir = '/webbbs'; }
 1372- if ($archive_subdir) {
 1373- $ArchiveDir = $data_basedir . $archive_subdir;
 1374- &make_dir($ArchiveDir);
 1375- }
 1376- 
 1377- $webbbs_text   = 'webbbs_text.pl';
 1378- $webbbs_custom = 'webbbs_custom.pl';
 1379- 
 1380- $UserProfileDir     = $data_basedir . '/_profiles';
 1381- $UserProfilePicsDir = $ENV{DOCUMENT_ROOT} . $html_basedir . '/profileimages';
 1382- $UserProfilePicsURL = 'http://' . $ENV{HTTP_HOST} . $html_basedir . '/profileimages';
 1383- my $ima_subdir = $live_subdir ? $live_subdir : $data_subdir;
 1384- $UserPicsDir      = $ENV{DOCUMENT_ROOT} . $html_basedir . '/images' . $ima_subdir;
 1385- $UserPicsURL      = 'http://' . $ENV{HTTP_HOST} . $html_basedir . '/images' . $ima_subdir;
 1386- $NaughtyWordsFile = $data_basedir . '/_var/NaughtyWordsFile.txt';
 1387- $BannedIPsFile    = $data_basedir . '/_var/BannedIPsFile.txt';
 1388- $UseLocking       = 1;
 1389- 
 1390- $password_file = $data_basedir . '/password.txt';
 1391- 
 1392- my $tmpl_default = $data_basedir . '/_tmpl';
 1393- for ( 'Meta', 'Header', 'Footer', 'MessageHeader', 'MessageFooter' ) {
 1394- next if ( ${ $_ . 'File' } );
 1395- ${ $_ . 'File' } =
 1396-     ( -e $tmpl_default . $tmpl_subdir . '/' . $_ . '.txt' )
 1397-     ? $tmpl_default . $tmpl_subdir . '/' . $_ . '.txt'
 1398-     : $tmpl_default . '/' . $_ . '.txt';
 1399- }
 1400- for ( 'form', 'post', 'profileedit', 'profilesave', 'bem', 'sendbem', 'tticket', 'abrep', 'taf' ) {
 1401- if (    ( !$QueryMode{$_} )
 1402-      || ( $QueryMode{$_} =~ /[^a-zA-Z0-9]/ ) )
 1403- {
 1404- $QueryMode{$_} = $_;
 1405- }
 1406- }
 1407- 
 1408- if ( !-s $dir . '/data.txt' ) {
 1409- for ( $data_subdir, '/_profiles', '/_var', '/_tmpl', '/_bindata', '/_sessions', '/_sessions/running', '/_sessions/sleeping' ) {
 1410- &make_dir( $data_basedir . $_ );
 1411- }
 1412- for ( '/images', '/images' . $ima_subdir, '/profileimages' ) {
 1413- &make_dir( $ENV{DOCUMENT_ROOT} . $html_basedir . $_ );
 1414- }
 1415- }
 1416- $BBSquery = '';
 1417- if ($use_semaphore_lock) {
 1418- $RL::Basic::BYPASS_FLOCK = 1;
 1419- }
 1420- unless ($DocType) {
 1421- $DocType = "<!DOCTYPE html PUBLIC '-//W3C//DTD HTML 4.01 Transitional//EN' " . "'http://www.w3.org/TR/html4/loose.dtd'>";
 1422- }
 1423- unless ($CharSet) { $CharSet = 'iso-8859-1'; }
 1424- $teaser_icon_url = $html_basedir . '/icons/text_show.png';
 1425- 
 1426- } ## end sub map_old_vars
 1427- 
 1428- sub parse_basic {
 1429- if ( $main::tbb->{'post'} ) {
 1430- ( $main::post, $main::get ) = ( $main::tbb->{'post'}, $main::tbb->{'get'} );
 1431- return;
 1432- }
 1433- unless ($main::basic) {
 1434- $main::basic = RL::Basic->new();
 1435- }
 1436- unless ( $main::post || $main::get ) {
 1437- ( $main::post, $main::get ) = $basic->parse( parse_separate => 1 );
 1438- }
 1439- } ## end sub parse_basic
 1440- 
 1441- sub make_dir {
 1442- my $mdir = shift;
 1443- return if ( -d "$mdir" );
 1444- mkdir( "$mdir", 0777 );
 1445- chmod 0777, "$mdir";
 1446- } ## end sub make_dir
 1447- 
 1448- sub prepare_searchindex {
 1449- $_[0] =~ s/[\-\_\,\;\.\:\#\'\+\*\~\\`\{\}\[\]\=\(\)\&\%\$\"\!\\\/\^\|\?\\]/ /g;
 1450- return $_[0];
 1451- }
 1452- 
 1453- 1;