# FILE: src-board-subs-2 #------------------------------------------------------------------------------- # This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved. # Its use is subject to the license agreement that can be found at the following # URL: http://www.chem.hope.edu/discus/license #------------------------------------------------------------------------------- #---SEPARATOR---# #REQ:new_file #REQ:get_date_time #REQ:get_number sub add_page { local ($newpage, $type, $url, $target, $tn, $mn, $grp, $datetime_in) = @_; local ($num, $dt, @sublist, $line, $str, $strg, $ts); $owner = $grp if $grp ne ""; $num = &get_number; if ($tn != 0) { $topic_number = $tn; $me_number = $mn; } $url = "$message_url/$topic_number/$num.$ext" if $type ne "LINK"; $dt = &get_date_time('long'); $dt =~ s/\W//g; $newpage = &remove_links($newpage); $url .= "?$dt" if ($type ne "LINK" && !$noqm); &lock("$message_dir/$topic_number/$me_number.$ext"); local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic_number,$me_number); $str = &JavaScript_prepare($newpage); $strg = "onMouseOver=\"return setStatus('$str')\""; $ts = &get_date_time('short'); $ts = $datetime_in if $datetime_in ne ""; $sublist .= "
  • $newpage $ts

    • \n" if $type ne "LINK"; $sublist .= "

  • $newpage

    • \n" if $type eq "LINK"; &set_page($topic_number, $me_number, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src); &unlock("$message_dir/$topic_number/$me_number.$ext"); &new_file ($topic_number, $num, $me_number, $owner, $newpage, $type) if $type ne "LINK"; return $num; } #---SEPARATOR---# sub rename_topic_form { local ($oldname, $topic_number, $username, $description_source) = @_; &header; print "Topic Properties\n"; print "$fs\n"; print "

    Topic Properties
    \n"; print "
    \n"; print "Board Manager: Topic Properties
    \n"; print "
    \n"; print "

    Topic Name

    $fs\n"; print "To change the topic name, edit the topic name (or enter a new name) in the\n"; print "text box below.

    \n"; print "
    $fs", "Name:

    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

    \n"; print "
    "; print "
    \n"; print "
    \n"; print "

    Topic Description

    $fs\n"; print "To change the description for this topic, which is displayed on the topics\n"; print "page, edit the topic description (or enter a new description) in the\n"; print "text box below.

    \n"; print "

    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

    \n"; print "
    \n"; print "
    \n"; print "

    META Tags

    \n"; print "\n"; print "\n"; print "\n"; print "
    "; print "$fs", "You can specify META tags, used by search engines when indexing\n"; print "pages, for all pages in this topic using the text entry boxes below.\n"; print "Do not use HTML or Discus formatting codes in your META tags.\n"; print "To learn more about how to use META tags, consult your favorite search\n"; print "engine.

    \n"; &get_page($topic_number, $topic_number); print "\n"; print "\n"; print "\n"; print "\n"; print "
    $fs", "Description:
    $fs", "Key Words:
    $fs", "Robots:

    \n"; print "\n"; print "

    \n"; print "\n"; exit(0); print "\n"; exit(0); } #---SEPARATOR---# sub change_topic_group_form { local ($topics, $username) = @_; @topics = split(/,/, $topics); &header; print "Change Topic Group\n"; print "\n"; print "$fs
    Change Topic Group
    \n"; print "
    \n"; print "Board Manager: Change Topic Group
    \n"; print "

    Change Topic Group

    \n"; print "
    \n"; print "
    $fs\n"; print "The following topic"; print "s have" if scalar(@topics) > 1; print " has" if scalar(@topics) == 1; print " been selected:

      \n"; foreach $topic (@topics) { &extract("//$topic/$topic.$ext"); print "
    • $topic_name (\u$owner)\n"; } print "

    Select New Group:   "; print "\n"; print "

    \n"; if ($pro) { print " Update posting"; print "/reading" if $pro; print " privileges as appropriate

    \n"; } else { print "\n"; } print "\n"; print "\n"; print "\n"; print "\n"; print "

    \n"; print "
    \n"; exit(0); } #---SEPARATOR---# sub add_moderator { local ($username, $newuser, $pass1, $pass2, $email, $full) = @_; $newuser =~ tr/A-Z/a-z/; $pass1 =~ tr/A-Z/a-z/; $pass2 =~ tr/A-Z/a-z/; while ($newuser =~ m|(\W)|g) { $o = ord($1); $m = $1; &error_message("Add Moderator Error", "Username is invalid (username may not contain the character $m).") if $o < 126; } while ($pass1 =~ m|(\W)|g) { $o = ord($1); $m = $1; &error_message("Add Moderator Error", "Password is invalid (password may not contain the character $m).") if $o < 126; } &error_message("Add Moderator Error", "The entered passwords do not match!") if $pass1 ne $pass2; $usercount = length($newuser); &error_message("Add Moderator Error", "The username is invalid (username must be between 1 and 20 characters).") if ($usercount < 1 || $usercount > 20); $passcount = length($pass1); &error_message("Add Moderator Error", "The entered passwords are invalid (password must be between 1 and 20 characters).") if ($passcount < 1 || $passcount > 20); open(PASSWD,"$admin_dir/passwd.txt") || &error_message("Add Moderator Error", "Cannot read password file (passwd.txt)! (Code 020401)"); @passwdline = ; close(PASSWD); foreach $line (@passwdline) { ($user, $encpass, $therest) = split(/:/, $line); &error_message("Add Moderator Error", "The selected username already exists as a moderator!") if $user eq $newuser; } srand(time); undef (@salt); for ($i=1; $i<=4; $i++) { push (@salt, int(rand(26))+65); } $salt = pack('c4', @salt); &lock("$admin_dir/passwd.txt"); if ($email =~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|) { $email_new = $email; } else { $email_new = "email"; } if ($full eq "") { $full = "fullname"; } else { $full =~ s/\n//g; $full =~ s/[:<>]//g; } $new_password = crypt($pass1, $salt); open(PASSWD,">>$admin_dir/passwd.txt") || &error_message("Add Moderator Error", "Cannot append password file (passwd.txt)! (Code 020202)"); print PASSWD "$newuser:$new_password:$email:$full:1::0\n"; close(PASSWD); &unlock("$admin_dir/passwd.txt"); } #---SEPARATOR---# sub delete_moderator { local ($toremove) = @_; local (@passwd, $line, $user, $therest); &lock("$admin_dir/passwd.txt"); open (PASSWD, "$admin_dir/passwd.txt") || &error_message("File Error", "Cannot open password file (passwd.txt) for reading! (Code 020501)"); @passwd = ; close (PASSWD); open (PASSWD, ">$admin_dir/passwd.txt") || &error_message("File Error", "Cannot open password file (passwd.txt) for writing! (Code 020502)"); foreach $line (@passwd) { ($user) = split(/:/, $line); print PASSWD $line if $toremove ne $user; } close (PASSWD); &unlock("$admin_dir/passwd.txt"); &lock("$admin_dir/groups.txt"); open (GRP, "$admin_dir/groups.txt"); @grp = ; close (GRP); foreach $line (@grp) { chop $line if $line =~ /\n/; ($group, $users) = split(/:/, $line); @users = split(/,/, $users); @users = grep(!/^$toremove$/, @users); $users = join(",", @users); $users .= "\n"; $line = join(":", $group, $users); } open (GRP, ">$admin_dir/groups.txt"); print GRP @grp; close (GRP); &unlock("$admin_dir/groups.txt"); if ($pro) { $line = $toremove; $profile_fn = &getfn("$line-MODERATOR.txt"); if (-e "$admin_dir/profiles/$profile_fn") { $PICT{'picture'} = ""; &ex('read_profile', "$profile_fn"); if ($PICT{'picture'} ne "") { unlink("$admin_dir/profiles/$PICT{'picture'}"); } unlink("$admin_dir/profiles/$profile_fn"); } } } #---SEPARATOR---# sub save_top_meta_tags { local ($descr, $keywords, $robots) = @_; &lock("$message_dir/board-topics.html"); open (MAIN, "$message_dir/board-topics.html"); @main =
    ; close (MAIN); $descr =~ s/"//g; $keywords =~ s/"//g; $robots =~ s/"//g; foreach $line (@main) { if ($line =~ m|^\n"; } elsif ($line =~ m|^\n"; } elsif ($line =~ m|^\n"; } } open (MAIN, ">$message_dir/board-topics.html"); print MAIN @main; close (MAIN); &unlock("$message_dir/board-topics.html"); } #---SEPARATOR---# #REQ:change_board_colors #REQ:determine_addmessage sub save_topic_meta_tags { local ($topic, $descr, $keywords, $robots) = @_; &lock("$message_dir/$topic/$topic.$ext"); open (MAIN, "$message_dir/board-topics.html"); @main =
    ; close (MAIN); $descr =~ s/"//g; $keywords =~ s/"//g; $robots =~ s/"//g; local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic,$topic); $colorstr = $color; $meta_description = $descr; $meta_keywords = $keywords; $meta_robots = $robots; &set_page ($topic, $topic, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src); &unlock("$message_dir/$topic/$topic.$ext"); ($template, $addfile) = &determine_addmessage($topic); &lock("*"); ®enerate_page($topic, $topic, $topic, $template, $addfile, 0, 1); &unlock("*"); } #---SEPARATOR---# sub upgrade_file_structure { # This upgrades file structure from version 2.50 to 3.00 # This affects users.txt, passwd.txt, posting.txt, security.txt, queue.txt, # postoptions.txt # First, make sure the board hasn't already been updated with this file structure open (USERS, "$admin_dir/users.txt"); @users = ; close (USERS); return 1 if grep(/^UPDATED300:/, @users); # If you have data in your posting.txt file, then you're already running # version 3.0! The thing above didn't work since you started with version 3.0. if (open(POSTING, "$admin_dir/posting.txt")) { @posting = ; close (POSTING); @p = grep(/^(\d+):/, @posting); if (scalar(@p)) { &lock("$admin_dir/users.txt"); open (USERS, ">>$admin_dir/users.txt"); print USERS "UPDATED300:*:::0:::\n"; close (USERS); &unlock("$admin_dir/users.txt"); return 1; } } # Clean up the log.txt file &lock("$admin_dir/log.txt"); open (LOG, "$admin_dir/log.txt"); @LOG = ; close (LOG); @LOG = grep(!/^D/, @LOG); open (LOG, ">$admin_dir/log.txt"); print LOG @LOG; close (LOG); &unlock("$admin_dir/log.txt"); # Determine the topic structure of the board undef @topics; undef %group; open (TOP, "$message_dir/board-topics.html"); @top = ; close (TOP); @top = grep(/^/, @top); foreach $line (@top) { $line =~ m||; $t = $1; &extract("//$t/$t.$ext"); push (@topics, $t); $group{$t} = $owner; } # Determine properties of groups and update e-mail notification undef %public; undef %moder; undef %user; undef %disable; undef %anon; undef %stamp; &lock("$admin_dir/users.txt"); open (USERS, "$admin_dir/users.txt"); @users = ; close (USERS); foreach $line (@users) { chop $line if $line =~ m|\n$|; ($user, $pass, $email, $full, $edit, $notify, $last, $group) = split(/:/, $line); if (($pass eq "*" || $pass eq "") && $full =~ m|\w+ USER - DO NOT|) { $public{$group} = 1 if $user eq "PUBLIC"; $moder{$group} = 1 if $user eq "MODERATORS"; $user{$group} = 1 if $user eq "USERS"; $disable{$group} = 1 if $user eq "DISABLE"; $anon{$group} = 1 if $user eq "DISABLEANON"; $stamp{$group} = 1 if $user eq "DISABLESTAMP"; $line = ""; } else { undef @notify; if ($notify == 2 || $notify == 3) { foreach $topic (@topics) { if ($group{$topic} eq $group) { push (@notify, $topic); } } } if ($notify == 1 || $notify == 3) { push (@notify, 0); } $notify = join(",", @notify); $line = join(":", $user, $pass, $email, $full, $edit, $notify, $last, "$group\n"); } } @users = grep(/\S/, @users); push (@users, "UPDATED300:*:::0:::\n"); open (USERS, ">$admin_dir/users.txt"); print USERS @users; close (USERS); &unlock("$admin_dir/users.txt"); # Update e-mail notification in passwd.txt file &lock("$admin_dir/passwd.txt"); &lock("$admin_dir/groups.txt"); undef %mods; open (PASSWD, "$admin_dir/passwd.txt"); @passwd = ; close (PASSWD); open (GROUPS, "$admin_dir/groups.txt"); @groups = ; close (GROUPS); &unlock("$admin_dir/groups.txt"); foreach $line (@groups) { chop ($line) if $line =~ m|\n$|; ($groupname, $mods) = split(/:/, $line); $mods{$groupname} = $mods; } foreach $line (@passwd) { chop $line if $line =~ m|\n$|; ($user, $pass, $email, $full, $edit, $notify, $last) = split(/:/, $line); undef @notify; if ($notify == 2 || $notify == 3) { foreach $topic (@topics) { $g = $group{$topic}; @ms = split(/,/, $mods{$g}); if (grep(/^$user$/, @ms)) { push (@notify, $topic); } } } if ($notify == 1 || $notify == 3) { push (@notify, 0); } $notify = join(",", @notify); $line = join(":", $user, $pass, $email, $full, $edit, $notify, "$last\n"); } open (PASSWD, ">$admin_dir/passwd.txt"); print PASSWD @passwd; close (PASSWD); &unlock("$admin_dir/passwd.txt"); # Write out the posting.txt and security.txt files with normal settings &lock("$admin_dir/posting.txt"); open (POSTING, ">$admin_dir/posting.txt"); foreach $topic (@topics) { $line_out = "$topic:"; $g = $group{$topic}; $line_out .= "~" if ($public{$g} && !$disable{$g}); $line_out .= ":"; $line_out .= "~" if ($moder{$g} && !$disable{$g}); $line_out .= "$g" if ($moder{$g} == 0 && !$disable{$g}); $line_out .= ":"; $line_out .= "~" if ($user{$g} && !$disable{$g}); $line_out .= "$g" if ($user{$g} == 0 && !$disable{$g}); $line_out .= ":\n"; print POSTING $line_out; } close (POSTING); &unlock("$admin_dir/posting.txt"); &lock("$admin_dir/security.txt"); open (SECURITY, ">$admin_dir/security.txt"); foreach $topic (@topics) { print SECURITY "$topic:~:::\n"; } close (SECURITY); &unlock("$admin_dir/security.txt"); # Write out the postoptions.txt file &lock(">$admin_dir/postoptions.txt"); open (POSTOPTIONS, ">$admin_dir/postoptions.txt"); foreach $topic (@topics) { $g = $group{$topic}; $line_out = "$topic:"; $line_out .= "1" if $anon{$g}; $line_out .= ":"; $line_out .= "1" if $stamp{$g}; $line_out .= ":"; $line_out .= "1" if $stamp{$g}; $line_out .= "\n"; print POSTOPTIONS $line_out; } close (POSTOPTIONS); &unlock("$admin_dir/postoptions.txt"); # Write out the queue.txt file &lock(">$admin_dir/queue.txt"); open (QUEUE, ">$admin_dir/queue.txt"); foreach $topic (@topics) { print QUEUE "$topic:0:0:0:0\n"; } close (QUEUE); &unlock(">$admin_dir/queue.txt"); } #---SEPARATOR---# #REQ:page_manager_navbar sub rename_subtopic_form { local ($referer, $page_number, $username) = @_; &extract($referer); &error_message("Permissions Error", "Only the superuser may rename a topic! (Code 020901)") if $topic_number == $page_number; &extract("//$topic_number/$page_number.$ext"); local ($oldname) = $me_name; &header; print "Subtopic Properties\n"; print "$fs\n"; print "
    Subtopic Properties
    \n"; &page_manager_navbar($topic_number, $page_number, "Subtopic Properties"); print "
    \n"; print "
    \n"; $oldname = &JavaScript_prepare($oldname); print "\n"; print "
    $fs", "Name:

    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
    \n"; exit(0); } #---SEPARATOR---# #REQ:page_manager_navbar sub rename_link_form { local ($referer, $linknum, $username) = @_; local ($file, $line, $topic, $page, $url, $target, $str); if ($referer =~ m|/(\d+)/(\d+)\.$ext|) { ($topic, $page) = ($1, $2); } else { &error_message("Link Properties Error", "Could not extract requested page."); } local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic,$page); @sublist = split(/\n/, $sublist); ($file) = grep(/^/, @sublist); $file =~ m|
  • (.*)| || &error_message("FAILED", $file); ($url, $target, $oldname) = ($1, $2, $4); &header; print "Link Properties\n"; print "$fs\n"; print "
    Link Properties
    \n"; &page_manager_navbar($topic, $page, "Link Properties"); print "
    \n"; print "
    \n"; $oldname = &remove_html($oldname); $oldname =~ s/"//g; print "\n"; print "\n"; print "
    $fs", "Name:
    $fs", "URL:
    $fs", "Frame:

    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

    \n"; exit(0); } #---SEPARATOR---# #REQ:recurse #REQ:JavaScript_prepare #REQ:extract_lastmodified #REQ:get_date_time sub rename_subtopic { local ($referer, $num, $newname) = @_; local ($file, @lines, $line); &extract($referer); $file = "$message_dir/$topic_number/$me_number.$ext" if -e "$message_dir/$topic_number/$me_number.$ext"; $file = "$secdir/$topic_number/$me_number.$ext" if !-e "$message_dir/$topic_number/$me_number.$ext"; &lock("$file"); open (FILER, $file) || &error_message("File Error", "Could not open page file."); @lines = ; close(FILER); foreach $line (@lines) { if ($line =~ //) { $line =~ /
  • ]*)>(.*)<\/A>/; $b = $`; $uno = $1; $a = $'; $two = "onMouseOver=\"return setStatus('"; $two .= &JavaScript_prepare($newname); $two .= "')\""; $line = join("", $b, "
  • $newname", $a); } } open (FILE, ">$file"); print FILE @lines; close (FILE); &unlock("$file"); &extract("/$topic_number/$num.$ext"); foreach $key (keys(%level_number)) { if ($level_number{$key} eq $num) { $keypl = $key; $type = "Level $keypl"; } } $type = "Level 1" if $type eq ""; $recurse_action = "rename:$type"; &recurse ($topic_number, $num, $recurse_action, $newname); } #---SEPARATOR---# #REQ:JavaScript_prepare sub rename_link { local ($referer, $linknum, $newname, $newurl, $newtarget) = @_; local ($file, $line, $topic, $page, $url, $target, $str); if ($referer =~ m|/(\d+)/(\d+)\.$ext|) { ($topic, $page) = ($1, $2); } else { &error_message("Rename Link Error", "Could not extract requested page."); } &lock("$message_dir/$topic/$page.$ext"); local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic,$page); @sublist = split(/\n/, $sublist); foreach $line (@sublist) { if ($line =~ //) { $line =~ /
  • (.*)<\/A>/; ($url, $target) = ($1, $2); $str = &JavaScript_prepare($newname); $url = $newurl if $newurl ne ""; $target = "TARGET=\"Main\"" if $newtarget eq "Main"; $target = "TARGET=\"_parent\"" if ($newtarget eq "_top" || $newtarget eq "_parent"); $target = "TARGET=\"_blank\"" if $newtarget eq "_blank"; $line = "
  • $newname

    • \n"; } } $sublist = join("\n", @sublist); &set_page($topic, $page, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src); &unlock("$message_dir/$topic/$page.$ext"); } #---SEPARATOR---# sub reorder_subtopics { local ($referer, $array) = @_; local ($topic_number,@ascending,$line,@lines,%newarray,$flag,$key, %printed); @ascending = split(/:/, $array); &extract($referer); &lock("$message_dir/$topic_number/$me_number.$ext"); local ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src) = &get_page($topic_number,$me_number); @sublist = split(/\n/, $sublist); undef %printed; foreach $line (@sublist) { if ($line =~ // || $line =~ //) { $newarray{$1} = $line; $printed{$1} = 0; } } undef @sublist; foreach $key (@ascending) { push (@sublist, $newarray{$key}); $printed{$key} = 1; } foreach $key (keys(%printed)) { push (@sublist, $newarray{$key}) if $printed{$key} == 0; } $sublist = join("\n", @sublist); &set_page($topic_number, $me_number, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src); &unlock("$message_dir/$topic_number/$me_number.$ext"); } #---SEPARATOR---# sub email_configuration { $mail_prog = $FORM{'mail_program'}; if ($mail_prog =~ m|[;"'\[\(\)\|\\`\*<>!~]|) { &error_message("Invalid Mail Program", "Mail program cannot contain metacharacters"); } elsif (!-x $mail_prog) { &error_message("Invalid Mail Program", "Mail program is not executable"); } $command_line = "| $mail_prog "; $input_stream = ""; if ($FORM{'chuckaddress'} !~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$| && $FORM{'1message'} == 1) { &error_message("Invalid E-mail Address", "The To: address is invalid"); } if ($FORM{'commandline'}) { $FORM{'commandline'} =~ s/[^\w\-]//g; $command_line .= $FORM{'commandline'}; } if ($FORM{'toaddress'} == 2) { &error_message("Invalid To Address", "The \"To\" address must be specified either in the input stream or on the command line"); } elsif ($FORM{'toaddress'} == 1) { $FORM{'toaddress_switch'} =~ s/[^\w\-]//g; $command_line .= " $FORM{'toaddress_switch'} \$TO" if $FORM{'1message'} == 0; $command_line .= " $FORM{'toaddress_switch'} $FORM{'chuckaddress'}" if $FORM{'1message'} == 1; } elsif ($FORM{'toaddress'} == 0) { $input_stream .= "$FORM{'toaddress_prefix'} \$TO\n" if $FORM{'1message'} == 0; $input_stream .= "$FORM{'toaddress_prefix'} $FORM{'chuckaddress'}\n" if $FORM{'1message'} == 1; } if ($FORM{'fromaddress'} == 1) { $FORM{'fromaddress_switch'} =~ s/[^\w\-]//g; $FROM = $FORM{'fromname'}; $FROM =~ s/[^\w\s\-\+\.\@]//g; $command_line .= " $FORM{'fromaddress_switch'} '$FROM'"; } elsif ($FORM{'fromaddress'} == 0) { $FROM = "\"$FORM{'fromname'}\" <$FORM{'fromaddr'}>"; $input_stream .= "$FORM{'fromaddress_prefix'} $FROM\n"; } if ($FORM{'useraddress'} == 1) { $FORM{'useraddress_switch'} =~ s/[^\w\-]//g; $FROM = $FORM{'fromaddr'}; $FROM =~ s/[^\w\s\-\+\.\@<>]//g; $command_line .= " $FORM{'useraddress_switch'} '$FROM'"; } elsif ($FORM{'useraddress'} == 0) { $FROM = "$FORM{'fromaddr'}"; $input_stream .= "$FORM{'useraddress_prefix'} $FROM\n"; } if ($FORM{'subjectaddress'} == 1) { $FORM{'subjectaddress_switch'} =~ s/[^\w\-]//g; $command_line .= " $FORM{'subjectaddress_switch'} '\$SUBJECT'"; } elsif ($FORM{'subjectaddress'} == 0) { $input_stream .= "$FORM{'subjectaddress_prefix'} \$SUBJECT\n"; } if ($FORM{'bccaddress'} == 1) { $FORM{'bccaddress_switch'} =~ s/[^\w\-]//g; $command_line .= " $FORM{'bccaddress_switch'} '\$BCC'" if $FORM{'1message'} == 1; } elsif ($FORM{'bccaddress'} == 0) { $input_stream .= "$FORM{'bccaddress_prefix'} \$BCC\n" if $FORM{'1message'} == 1; } if ($FORM{'replytoaddress'} == 1) { if ($FORM{'fromaddr'} =~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|) { $FORM{'replytoaddress_switch'} =~ s/[^\w\-]//g; $command_line .= " $FORM{'replytoaddress_switch'} '$FORM{fromaddr}'"; } } elsif ($FORM{'replytoaddress'} == 0) { if ($FORM{'fromaddr'} =~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|) { $input_stream .= "$FORM{'replytoaddress_prefix'} $FORM{fromaddr}\n"; } } if ($FORM{'submit'} ne "Test") { &lock("$admin_dir/email.txt"); open (EMAIL, ">$admin_dir/email.txt"); print EMAIL "command_line=$command_line\n"; print EMAIL "input_stream=", &escape($input_stream), "\n"; print EMAIL "mail_program=$mail_prog\n"; print EMAIL "1message=$FORM{'1message'}\n"; print EMAIL "chuckaddress=$FORM{'chuckaddress'}\n"; print EMAIL "commandline=$FORM{'commandline'}\n"; print EMAIL "fromname=$FORM{'fromname'}\n"; print EMAIL "fromaddr=$FORM{'fromaddr'}\n"; print EMAIL "subjectline=$FORM{'subjectline'}\n"; print EMAIL "static=$FORM{'static'}\n"; print EMAIL "toaddress=$FORM{'toaddress'}\n"; print EMAIL "toaddress_prefix=$FORM{'toaddress_prefix'}\n"; print EMAIL "toaddress_switch=$FORM{'toaddress_switch'}\n"; print EMAIL "fromaddress=$FORM{'fromaddress'}\n"; print EMAIL "fromaddress_prefix=$FORM{'fromaddress_prefix'}\n"; print EMAIL "fromaddress_switch=$FORM{'fromaddress_switch'}\n"; print EMAIL "subjectaddress=$FORM{'subjectaddress'}\n"; print EMAIL "subjectaddress_prefix=$FORM{'subjectaddress_prefix'}\n"; print EMAIL "subjectaddress_switch=$FORM{'subjectaddress_switch'}\n"; print EMAIL "useraddress=$FORM{'useraddress'}\n"; print EMAIL "useraddress_prefix=$FORM{'useraddress_prefix'}\n"; print EMAIL "useraddress_switch=$FORM{'useraddress_switch'}\n"; print EMAIL "bccaddress=$FORM{'bccaddress'}\n"; print EMAIL "bccaddress_prefix=$FORM{'bccaddress_prefix'}\n"; print EMAIL "bccaddress_switch=$FORM{'bccaddress_switch'}\n"; print EMAIL "replytoaddress=$FORM{'replytoaddress'}\n"; print EMAIL "replytoaddress_prefix=$FORM{'replytoaddress_prefix'}\n"; print EMAIL "replytoaddress_switch=$FORM{'replytoaddress_switch'}\n"; print EMAIL "sendtext=$FORM{'sendtext'}\n"; print EMAIL "tempfile=$FORM{'tempfile'}\n"; close (EMAIL); &unlock("$admin_dir/email.txt"); } elsif ($FORM{'submit'} eq "Test") { if ($FORM{'testemail'} !~ m|^([\w\-\+\.]+)\@([\w\-\+\.]+)$|) { &error_message("Test E-mail Error", "You did not give a valid address to which to send the mail"); } else { if ($FORM{'subjectline'} == 0) { $SUBJECT = "Options Manager: E-mail Configurator: Test"; } else { $SUBJECT = $FORM{'static'}; $SUBJECT =~ s/[^\w\s\-\+\.]//g; } $command_line =~ s/\$SUBJECT/$SUBJECT/g; $input_stream =~ s/\$SUBJECT/$SUBJECT/g; if ($FORM{'1message'} == 0) { $TO = $FORM{'testemail'}; $command_line =~ s/\$TO/$TO/g; $input_stream =~ s/\$TO/$TO/g; } else { $TO = $FORM{'chuckaddress'}; $BCC = $FORM{'testemail'}; } $command_line =~ s/\$TO/$TO/g; $input_stream =~ s/\$TO/$TO/g; $command_line =~ s/\$BCC/$BCC/g; $input_stream =~ s/\$BCC/$BCC/g; if ($FORM{'tempfile'} == 1) { $command_line =~ s%^\|\s*%%; $pid = $$; $pid =~ s/\D//g; $time = time; $tempfile = "$message_dir/$time-$pid.tmp"; open (MAILER, ">$tempfile"); } else { open (MAILER, "$command_line"); } print MAILER $input_stream; print MAILER "\n"; print MAILER "This is a test of e-mail notification. If you received it and\n"; print MAILER "all parameters are correct, then e-mail notification is properly\n"; print MAILER "set up on your server! Make sure that you use your browser's\n"; print MAILER "back button to save your settings.\n\n"; print MAILER "-" x 50, "\n"; print MAILER "This command line: $command_line\n\n"; print MAILER "This input stream follows:\n\n"; print MAILER $input_stream; print MAILER "-" x 50, "\n"; print MAILER "- DON'T FORGET TO SAVE YOUR SETTINGS! -\n\n"; print MAILER "- This is the end of the test -\n"; close (MAILER); if ($FORM{'tempfile'} == 1) { $pr = $mail_prog; if ($command_line =~ m|$pr|) { $stuff = $'; $command_line = $pr; } else { $stuff = ""; } if ($^O eq "MSWin32") { $mail_prog =~ s/\//\\/g; $tempfile =~ s/\//\\/g; $stuff =~ s/'/"/g; $stuff =~ s/^\s*//; if ($mail_prog =~ m|(.*)\\|) { $cwd = $1; } else { $cwd = "."; } eval ' use Win32::Process; use Win32; Win32::Process::Create($ProcessObj, $mail_prog, "$mail_prog $tempfile $stuff", 0, DETACHED_PROCESS, $cwd) || &error_message("Windows Process Creation Error", Win32::FormatMessage(Win32::GetLastError())); $ProcessObj->Wait(INFINITE); '; } else { system("$command_line", "$tempfile", "$stuff"); } unlink ($tempfile); } &header; print "E-mail Configurator -- Message Sent\n"; print '$fs\n"; print "

    E-mail Configurator -- Message Sent
    \n"; print "
    \n"; print "A test message was sent to the address you provided ($FORM{'testemail'}).\n"; print "

    Access your mail program and see if the message went through. If it did,\n"; print "click the "Save Settings" button below. If it failed, you\n"; print "can "Exit Without Saving" using the button below.

    \n"; print "

    \n"; print "\n"; print "\n"; foreach $key (keys(%FORM)) { next if $key eq "submit"; next if $key eq "action"; next if $key eq "username"; print "\n"; } print "\n"; print "\n"; print "
    \n"; print "\n"; exit(0); } } } #---SEPARATOR---# sub html_to_webtags { local ($message_in) = @_; $message_in =~ s/\\/^#92;/g; $message_in =~ s/\{/{/g; $message_in =~ s/\}/}/g; while ($message_in =~ m|<(\s+)([^>]+)(\s*)>|) { $two = $2; $message_in = join("", $`, "<", $two, ">", $'); } while ($message_in =~ m|<(\s*)([^>]+)(\s+)>|) { $two = $2; $message_in = join("", $`, "<", $two, ">", $'); } $message_in = &html_to_webtags_1($message_in, '', '', 'b'); $message_in = &html_to_webtags_1($message_in, '', '', 'i'); $message_in = &html_to_webtags_1($message_in, '', '', 'u'); $message_in = &html_to_webtags_1($message_in, '', '', 'c'); $message_in = &html_to_webtags_1($message_in, '
    ', '
    ', 'c'); $message_in = &html_to_webtags_1($message_in, '', '', 'strike'); $message_in = &html_to_webtags_1($message_in, '', '', 'blink'); $message_in = &html_to_webtags_1($message_in, '

    ', '

    ', '2'); $message_in = &html_to_webtags_1($message_in, '

    ', '

    ', '2'); $message_in = &html_to_webtags_1($message_in, '

    ', '

    ', '1'); $message_in = &html_to_webtags_1($message_in, '

    ', '

    ', '0'); $message_in = &html_to_webtags_1($message_in, '', '', '+'); $message_in = &html_to_webtags_1($message_in, '', '', '-'); $message_in = &html_to_webtags_1($message_in, '
    ', '
    ', 'pre'); while ($message_in =~ m|]+)>|i) { $args = " $1"; $bef = $`; $aft = $'; ($b, $a) = &match_close($aft, ''); if ($b ne "") { $begin_tag = ""; $end_tag = ""; $args =~ s|(\w+)\s*=\s*([^"])(\S*)|\1="\2\3"|gi; if ($args =~ m|\s+HREF\s*=\s*"([^"]+)"|i) { $col = $1; $begin_tag .= "\\topurl{$col,"; $end_tag .= "}"; } $message_in = join("", $bef, $begin_tag, $b, $end_tag, $a); } else { $message_in = join("", $bef, $aft); } } while ($message_in =~ m|]+)>|i) { $aft = $'; $bef = $`; $args = " " . $1; ($b, $a) = &match_close($aft, ''); if ($b ne "") { $begin_tag = ""; $end_tag = ""; $args =~ s|(\w+)\s*=\s*([^"])(\S*)|$1="$2$3"|g; if ($args =~ m|\s+COLOR\s*=\s*"([^"]+)"|i) { $col = $1; $col =~ s/#//; $col =~ s/"//g; $begin_tag .= "\\rgb{$col,"; $end_tag .= "}"; } if ($args =~ m|\s+FACE\s*=\s*"([^"]+)"|i) { $col = $1; $col =~ s/#//; $col =~ s/"//g; $col =~ s/,/\\,/g; $begin_tag .= "\\font{$col,"; $end_tag .= "}"; } if ($args =~ m|\s+SIZE\s*=\s*"([^"]+)"|i) { $col = $1; $col =~ s/#//; $col =~ s/"//g; if ($col eq "-1") { $begin_tag .= "\\-1{"; $end_tag .= "}"; } elsif ($col eq "-2") { $begin_tag .= "\\-2{"; $end_tag .= "}"; } elsif ($col eq "-2") { $begin_tag .= "\\-2{"; $end_tag .= "}"; } elsif ($col eq "+2") { $begin_tag .= "\\2{"; $end_tag .= "}"; } elsif ($col eq "+1") { $begin_tag .= "\\1{"; $end_tag .= "}"; } elsif ($col eq "+0") { $begin_tag .= "\\0{"; $end_tag .= "}"; } elsif ($col eq "-0") { $begin_tag .= "\\0{"; $end_tag .= "}"; } elsif ($col eq "1") { $begin_tag .= "\\-2{"; $end_tag .= "}"; } elsif ($col eq "2") { $begin_tag .= "\\-1{"; $end_tag .= "}"; } elsif ($col eq "3") { $begin_tag .= "\\0{"; $end_tag .= "}"; } elsif ($col eq "4") { $begin_tag .= "\\1{"; $end_tag .= "}"; } elsif ($col > 4) { $begin_tag .= "\\2{"; $end_tag .= "}"; } } $message_in = join("", $bef, $begin_tag, $b, $end_tag, $a); } else { $message_in = join("", $bef, $aft); } } return $message_in; } sub html_to_webtags_1 { local ($message_in, $opening, $closing, $webtag) = @_; while ($message_in =~ m|$opening|i) { $after1 = $'; $before1 = $`; if ($after1 =~ m|$closing|i) { $before2 = $`; $after2 = $'; $message_in = join("", $before1, "\\", $webtag, "{", $before2, "}", $after2); } else { return $message_in; } } return $message_in; } sub match_close { local ($stringin, $expected_close) = @_; if ($stringin =~ m|$expected_close|i) { return ($`, $'); } else { return ("", ""); } }