home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / adm-opts.pl < prev    next >
Text File  |  2009-11-06  |  21KB  |  666 lines
  1. # FILE: adm-opts.pl
  2. # DESCRIPTION: Options Manager
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### OPTS_admin
  20. ###
  21. ### Runs the Options Manager
  22. ###
  23.  
  24. sub OPTS_admin {
  25.     my ($FORMref) = @_;
  26.     my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  27.     bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  28.     bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  29.     options_mgr($FORMref, $result) if $FORMref->{action} eq "options_mgr";
  30.     options_mailconfig($FORMref, $result) if $FORMref->{c} eq "mail_config";
  31.     options_formsave($FORMref, $result) if $FORMref->{action} eq "options_save";
  32.     options_profanity($FORMref, $result) if $FORMref->{action} eq "options_profanity";
  33.     options_domains($FORMref, $result) if $FORMref->{action} eq "options_domains";
  34.     options_private_log($FORMref, $result) if $FORMref->{action} eq "options_private_log";
  35.     options_email_defaults($FORMref, $result) if $FORMref->{action} eq "options_email_default";
  36.     options_mailpop($FORMref, $result) if $FORMref->{action} eq "options_email_cfg";
  37.     options_mail_save($FORMref, $result) if $FORMref->{action} eq "options_mail_save";
  38.     options_speller($FORMref, $result) if $FORMref->{action} =~ m|^options_mgr_sd(\d)$|;
  39. }
  40.  
  41. ###
  42. ### options_mail_save
  43. ###
  44. ### Save or test e-mail notification settings
  45. ###
  46.  
  47. sub options_mail_save {
  48.     my ($FORMref, $result) = @_;
  49.     dreq("mailer");
  50.     my $j = readfile("$DCONF->{admin_dir}/email.txt", "options_mail_save", { create => 1, zero_ok => 1, no_lock => 1, no_unlock => 1 });
  51.     my $Q = email_configuration_read($j);
  52.     if ($Q->{no_use} != 1) {
  53.         foreach my $d ('to', 'from', 'subject', 'replyto', 'bcc', 'user') {
  54.             my $D = join("", $d, "address");
  55.             $Q->{$D} = $FORMref->{$D};
  56.             $Q->{join("_", $D, 'prefix')} = $FORMref->{join("_", $D, 'prefix')};
  57.         }
  58.         foreach my $d ('lineformat', 'tempfile', 'test_email_address', '1message', 'mail_program', 'commandline', 'commandlineend', 'net_SMTP', 'SMTP', 'SMTP2', 'SMTP3') {
  59.             $Q->{$d} = $FORMref->{$d};
  60.         }
  61.         ($Q->{command_line}, $Q->{input_stream}) = construct_command_line_string($Q);
  62.     }
  63.     if ($FORMref->{no_test} == 1) {
  64.         if ($Q->{no_use} != 1) {
  65.             email_configuration_save($Q, undef);
  66.             options_mailpop($FORMref, $result, { saved => 1 });
  67.         } else {
  68.             options_mailpop($FORMref, $result, {});
  69.         }
  70.     }
  71.     if ($FORMref->{test_email_address} =~ /^([\w\+\-\.]+)\@([\w\+\-\.]+)$/) {
  72.         my $o; my $F;
  73.         if ($Q->{no_use} != 1) {
  74.             $o = email_configuration_save($Q, $j);
  75.             $F = email_configuration_read($o);
  76.         } else {
  77.             $F = $Q;
  78.         }
  79.         my $sh = { to => $FORMref->{test_email_address}, subject => read_language()->{EMAIL_NOTIFICATION_TEST_SUBJECT} };
  80.         my $mm = {};
  81.         my @var = map { name => $_, setting => $F->{$_} }, keys(%{$F});
  82.         $mm->{var} = \@var;
  83.         $mm->{general}->{username} = $result->[0]->{user};
  84.         $mm->{general}->{pwstring} = crypt($result->[0]->{pass}, "cookie");
  85.         $mm->{general}->{reply_disabled} = 1 if $F->{'1message'} == 1;
  86.         my $txt = templ_int("testmail", $mm);
  87.         send_email_message($sh, $txt, $F, 1);
  88.         my $subst = {};
  89.         $subst->{mail} = $F;
  90.         $subst->{mail} = $subst->{guess} if ! defined $subst->{mail}->{net_SMTP};
  91.         $subst = options_email_config($subst, $o);
  92.         $subst->{general}->{username} = $result->[0]->{user};
  93.         $subst->{general}->{cron_available} = (-e "$DCONF->{admin_dir}/mailqueue" ? 1 : 0 );
  94.         $subst->{general}->{sent} = 1;
  95.         screen_out("mailpop", $subst);    
  96.     } else {
  97.         error_message("Invalid Test Address", "The e-mail address you entered to send the test to is not valid.", 0, 1);
  98.     }
  99. }
  100.  
  101. ###
  102. ### options_email_defaults
  103. ###
  104. ### Defaults for e-mail notification
  105. ###
  106.  
  107. sub options_email_defaults {
  108.     my ($FORMref, $result) = @_;
  109.     my $subst = {};
  110.     my $q = board_topics(undef, undef, undef, 1);
  111.     dreq("ui-prfle");
  112.     if ($DCONF->{pro} && $GLOBAL_OPTIONS->{email_bysubtopic}) {
  113.         dreq("fcn-prfl-PRO");    
  114.         $subst = (profile_editor_email_notification_pro($subst, $FORMref, "", "", undef, $q, $GLOBAL_OPTIONS->{default_notify_string}))[0];
  115.     } else {
  116.         my @q = @{$q};
  117.         my @f2 = ();
  118.         my $notify = email_notification_to_hash($GLOBAL_OPTIONS->{default_notify_string});
  119.         foreach my $topic (@q) {
  120.             next if $topic->{type} != 1;
  121.             my $sel = 0;
  122.             $sel = 2 if defined $notify->{$topic->{number}};
  123.             $sel = 1 if defined $notify->{$topic->{number}}->{'*'};
  124.             push @f2, { number => $topic->{number}, name => $topic->{name}, sel => $sel };
  125.         }
  126.         $subst->{notify} = $notify;
  127.         $subst->{notify_topics} = \@f2;
  128.     }
  129.     $subst->{general}->{username} = $result->[0]->{user};
  130.     screen_out("em_def", $subst);    
  131. }
  132.  
  133. ###
  134. ### options_domains
  135. ###
  136. ### Banned domains for user self-registration
  137. ###
  138.  
  139. sub options_domains {
  140.     my ($FORMref, $result) = @_;
  141.     dreq("selfreg-PRO"); options_domains_pro($FORMref, $result);
  142. }
  143.  
  144. ###
  145. ### options_private_log
  146. ###
  147. ### View private messaging log
  148. ###
  149.  
  150. sub options_private_log {
  151.     my ($FORMref, $result) = @_;
  152.     dreq("pvtmsg-PRO"); options_private_log_pro($FORMref, $result);
  153. }
  154.     
  155.  
  156. ###
  157. ### options_profanity
  158. ###
  159. ### Configuration and testing of profanity filter
  160. ###
  161.  
  162. sub options_profanity {
  163.     my ($FORMref, $result) = @_;
  164.     my $subst = {};
  165.     $subst->{general}->{username} = $result->[0]->{user};
  166.     $subst->{general}->{screen} = 0 + $FORMref->{screen};
  167.     if ($FORMref->{changed} == 2) {
  168.         dreq("profane");
  169.         my $z = profanity_filter($FORMref->{testword}, { force_read => 1, force_check => 1, error_report => 3 });
  170.         if ($z ne "") {
  171.             my @z = ($z);
  172.             $subst->{general}->{match} = cuss_convert_perlregexp_to_discusregexp(\@z)->[0]->{word};
  173.         }
  174.         $subst->{general}->{screen} = 1;
  175.         $subst->{general}->{entry} = $FORMref->{testword};
  176.     } else {
  177.         my $cuss = undef;
  178.         if ($FORMref->{words}) {
  179.             $cuss = cuss_save($FORMref->{words});
  180.         } else {
  181.             dreq("profane");
  182.             $cuss = read_cuss_file(1);
  183.         }
  184.         $subst->{words} = cuss_convert_perlregexp_to_discusregexp($cuss);
  185.     }
  186.     $subst->{checkup} = options_profanity_scanner();
  187.     screen_out("cussedit", $subst, undef);
  188. }
  189.  
  190. ###
  191. ### options_profanity_scanner
  192. ###
  193. ### Sees if your word list is too redundant
  194. ###
  195.  
  196. sub options_profanity_scanner {
  197.     dreq("profane");
  198.     my $cussfile = ref $_[0] eq 'ARRAY' ? $_[0] : read_cuss_file(1);
  199.     my %l = map { $_, 1 } @{$cussfile};
  200.     my $l = \%l;
  201.     my $dup = {};
  202.     my $cby = {};
  203.     foreach my $word (@{$cussfile}) {
  204.         next if $word !~ /\S/;
  205.         my @x = grep { $_ ne $word } @{$cussfile};
  206.         $dup->{$word} = 1 if scalar (grep { $_ ne $word } @x) != scalar @{$cussfile} - 1;
  207.         my $cuss = {};
  208.         @x = map { my $j = $_; s%\(\S\*\)%MNBVCXZ%g; s%\(\\S\)%\^%g; s%\(\\S\+\)%ZXCVBNM%g; { orig => $j, now => $_ }} @x;
  209.         foreach my $x (@x) {
  210.             my $wd = $word;
  211.             eval "'foo' =~ /^$wd$/i";
  212.             $wd = quotemeta($word) if $@;            
  213.             $cuss->{cuss_found}->{$x->{orig}} = 1 if $x->{now} =~ /^$wd$/i;
  214.         }
  215.         next if scalar keys %{$cuss->{cuss_found}} == 0;
  216.         my %z = map { $_, 1 } grep { $_ ne $word } keys %{$cuss->{cuss_found}};
  217.         $cby->{$word} = \%z;
  218.     }
  219.     my $i = {};
  220.     my @dup = sort { lc($a->{word}) cmp lc($b->{word}) } map { cuss_convert_perlregexp_to_discusregexp([$_])->[0] } keys %{$dup};
  221.     $i->{duplicate} = \@dup;
  222.     my @cby = sort { lc($a->{word}) cmp lc($b->{word}) } map { cuss_convert_perlregexp_to_discusregexp([$_])->[0] } keys %{$cby};
  223.     $i->{caughtby} = \@cby;
  224.     my $l2 = {};
  225.     foreach my $k (keys %{$cby}) {
  226.         foreach my $z (keys %{$cby->{$k}}) {
  227.             $l2->{$z} = 1;
  228.         }
  229.     }
  230.     $i->{duplicate_keys} = scalar keys %{$dup};
  231.     $i->{caughtby_keys} = scalar keys %{$cby};
  232.     my @cby2 = sort { lc($a->{word}) cmp lc($b->{word}) } map { cuss_convert_perlregexp_to_discusregexp([$_])->[0] } keys %{$l2};
  233.     $i->{caughtby_2} = \@cby2;
  234.     return $i;
  235. }
  236.  
  237. ###
  238. ### cuss_save
  239. ###
  240. ### Converts actual Discus regular expressions to Perl regular expressions
  241. ### for display, and saves the results
  242. ###
  243.  
  244. sub cuss_save {
  245.     my ($input) = @_;
  246.     $input =~ s/\r/\n/g;
  247.     my @i = split(/\n/, $input);
  248.     my @z = ();
  249.     foreach my $j (@i) {
  250.         next if $j !~ /\S/;
  251.         my $z = quotemeta(trim($j));
  252.         $z =~ s/\\\?/\(\\S\)/g;
  253.         $z =~ s/\\\*/\(\\S\*\)/g;
  254.         $z =~ s/\\\+/\(\\S\+\)/g;
  255.         push @z, $z;
  256.     }
  257.     writefile("$DCONF->{admin_dir}/cuss.txt", \@z, "naughty_words", { zero_ok => 1, no_lock => 1, no_unlock => 1 });
  258.     $PARAMS->{'naughty_words'} = \@z;
  259.     return \@z;
  260. }
  261.  
  262. ###
  263. ### cuss_convert_perlregexp_to_discusregexp
  264. ###
  265. ### Converts actual Perl regular expressions to Discus regular expressions
  266. ### for display
  267. ###
  268.  
  269. sub cuss_convert_perlregexp_to_discusregexp {
  270.     my ($list) = @_;
  271.     my @z = ();
  272.     foreach my $word (@{ $list }) {
  273.         my $z = $word;
  274.         $z =~ s/\(\\S\*\)/\*/g;
  275.         $z =~ s/\(\\S\)/\?/g;
  276.         $z =~ s/\(\\S\+\)/\+/g;
  277.         $z =~ s/\\//g;
  278.         push @z, { word => $z };
  279.     }
  280.     return \@z;
  281. }
  282.  
  283. ###
  284. ### options_mailconfig
  285. ###
  286. ### Configuration for e-mail notification, form saving
  287. ###
  288.  
  289. sub options_mailconfig {
  290.     my ($FORMref, $result) = @_;
  291.     my $s = {};
  292.     my @av = ("fromaddr", "fromname", "chuckaddress");
  293.     foreach my $x (@av) {
  294.         $s->{$x} = $FORMref->{$x};
  295.     }
  296.     dreq("mailer");
  297.     email_configuration_save($s, undef);    
  298. }
  299.  
  300.  
  301. ###
  302. ### options_speller
  303. ###
  304. ### Configures the spell checker
  305. ###
  306.  
  307. sub options_speller {
  308.     my ($FORMref, $result) = @_;
  309.     dreq("speller-PRO");
  310.     speller_config($FORMref, $result);
  311. }
  312.  
  313. ###
  314. ### options_formsave
  315. ###
  316. ### Saves options that were found on the form
  317. ###
  318.  
  319. sub options_formsave {
  320.     my ($FORMref, $result) = @_;
  321.     my $n = {};
  322.     foreach my $u (split(/,/, $FORMref->{a})) {
  323.         $n->{$u} = $FORMref->{$u} != 0 ? $FORMref->{$u} : 0;
  324.     }
  325.     foreach my $u (split(/,/, $FORMref->{b})) {
  326.         $n->{$u} = defined $FORMref->{$u} ? $FORMref->{$u} : "";
  327.     }
  328.     foreach my $u (split(/,/, $FORMref->{c})) {
  329.         $n->{$u} = options_c_saver($u, $FORMref);        
  330.     }
  331.     if ($FORMref->{d}) {
  332.         dreq("webtags");
  333.         foreach my $u (split(/,/, $FORMref->{d})) {
  334.             if ($FORMref->{$u} !~ /\S/) {
  335.                 $n->{$u} = "";
  336.             } else {
  337.                 my ($messages, $formatted) = webtags($FORMref->{$u}, 1, 1, 1, 1);
  338.                 if ($messages eq "!Error") {
  339.                     error_message(read_language()->{FORMATTINGERROR}, $formatted, 0, 1);
  340.                 }
  341.                 $n->{$u} = $formatted;
  342.             }
  343.         }
  344.     }
  345.     if ($FORMref->{e}) {
  346.         dreq("ipaddr-PRO");
  347.         options_mgr_save_ip_bans($FORMref);
  348.     }
  349.     if ($FORMref->{f}) {
  350.         dreq("mailer");
  351.         my $j = readfile("$DCONF->{admin_dir}/email.txt", "options_formsave", { create => 1, zero_ok => 1, no_lock => 1, no_unlock => 1 });
  352.         my $Q = email_configuration_read($j);
  353.         ($Q->{command_line}, $Q->{input_stream}) = construct_command_line_string($Q);
  354.         email_configuration_save($Q, undef);
  355.     }
  356.     $GLOBAL_OPTIONS = options_save($n);
  357.     if ($DCONF->{pro} && $FORMref->{menu} == 4) {
  358.         dreq("authwrap-PRO");
  359.         put_topics_file_in_correct_place();
  360.     }
  361.     options_mgr($FORMref, $result, { saved => 1 });
  362. }
  363.  
  364. ###
  365. ### options_c_saver
  366. ###
  367. ### Special saving algorithms
  368. ###
  369.  
  370. sub options_c_saver {
  371.     my ($option, $FORMref) = @_;
  372.     if ($option eq "default_notify_string") {
  373.         my $k = $FORMref->{default_notify_string};
  374.         my @k = split(/,/, $k);
  375.         my @l = ();
  376.         foreach my $z (@k) {
  377.             if ($z =~ /^(\d+):$/) {
  378.                 push @l, $1;
  379.             } else {
  380.                 $z =~ s/:/\//g;
  381.                 push @l, $z;
  382.             }
  383.         }        
  384.         return join(",", @l);
  385.     }
  386.     if ($option eq "fields_display") {
  387.         my $k = $FORMref->{fields_display};
  388.         $k =~ s/,/\//g;
  389.         $k = "/$k/";
  390.         return $k;
  391.     }
  392.     if ($option eq "mod_session_expire") {
  393.         my $k = $FORMref->{u_last_access_info};
  394.         return $GLOBAL_OPTIONS->{mod_session_expire} if $k == 0;
  395.         return 0;
  396.     }
  397.     if ($option eq "allusers_dispfield") {
  398.         my $k = $FORMref->{allusers_dispfield};
  399.         $k =~ s/,/\//g;
  400.         $k = "/$k/";
  401.         return $k;
  402.     }
  403.     if ($option eq "debug_users") {
  404.         my $k = $FORMref->{debug_users};
  405.         my @u = split(/,/, $k);
  406.         dreq("authpass");
  407.         foreach my $u (@u) { $u = prepare_userpass($u); }
  408.         @u = sort grep (/\S/, @u);
  409.         return join(",", @u);        
  410.     }    
  411.     if ($option eq "default_prefs") {
  412.         return "" if ! defined $FORMref->{pref};
  413.         my $k = $FORMref->{pref};
  414.         $k =~ s/\W//g;
  415.         return $k;
  416.     }    
  417.     if ($option eq "permanent_prefs") {
  418.         return "" if ! defined $FORMref->{permpref};
  419.         my $k = $FORMref->{permpref};
  420.         $k =~ s/\W//g;
  421.         return $k;
  422.     }    
  423.     if ($option eq "profile_fields") {
  424.         my $f = {};
  425.         foreach my $key (keys(%{ $FORMref })) {
  426.             next if $key eq "require_valid_email";
  427.             $f->{$1}->{display} = $FORMref->{$key} if $key =~ m|^show_(\w+)$|;
  428.             $f->{$1}->{require} = $FORMref->{$key} if $key =~ m|^require_(\w+)$|;
  429.             $f->{$1}->{order} = $FORMref->{$key} if $key =~ m|^order_(\w+)$|;
  430.             $f->{$1}->{type} = $FORMref->{$key} if $key =~ m|^type_(\w+)$|;
  431.             $f->{$1}->{size} = $FORMref->{$key} if $key =~ m|^rows_(\w+)$|;
  432.             $f->{$1}->{descr} = $FORMref->{$key} if $key =~ m|^descr_(\w+)$|;
  433.         }
  434.         my $max = 0;
  435.         if ($f->{new}->{descr} ne "") {
  436.             foreach my $key (keys(%{ $f })) {
  437.                 $max = $key if $key > $max;
  438.             }
  439.             if ($max == 20) {
  440.                 for (my $i = 20; $i >= 1; $i--) {
  441.                     if ($f->{$i}->{descr} eq "") {
  442.                         $max = $i;
  443.                         last;
  444.                     }
  445.                 }
  446.             } else {
  447.                 $max++;
  448.             }
  449.         }
  450.         my $q = {};
  451.         my $ctr = 0;
  452.         my @f = sort { $f->{$a}->{order} <=> $f->{$b}->{order} } keys(%{ $f });
  453.         foreach my $ff (@f) {
  454.             next if $ff eq "new" && $max == 0;
  455.             my $j = $ff ne "new" ? $ff : $max;
  456.             $q->{$j} = $f->{$ff};
  457.             $ctr++;
  458.             $q->{$j}->{order} = $ctr;            
  459.         }
  460.         my @k = ();
  461.         foreach my $key (sort { $a <=> $b } keys(%{ $q })) {
  462.             my $fk = $q->{$key};
  463.             my $l = join(":", $key, $fk->{descr}, $fk->{display}, $fk->{type}, $fk->{size}, $fk->{require}, $fk->{order});
  464.             push @k, "$l\n";            
  465.         }
  466.         my $filename = "$DCONF->{admin_dir}/data/fields.txt";
  467.         writefile($filename, \@k, "options_c_saver", { no_lock => 1, no_unlock => 1, zero_ok => 1 });        
  468.     }
  469.     return $FORMref->{$option};    
  470. }
  471.  
  472.  
  473. ###
  474. ### options_mailpop
  475. ###
  476. ### Pop-up technical configuration of e-mail program
  477. ###
  478.  
  479. sub options_mailpop {
  480.     my ($FORMref, $result, $stuff) = @_;
  481.     dreq("mailer");
  482.     my $subst = {};
  483.     $subst->{general}->{username} = $result->[0]->{user};
  484.     $subst->{stuff} = $stuff;
  485.     $subst->{guess} = email_guess_settings();
  486.     $subst->{general}->{cron_available} = (-e "$DCONF->{admin_dir}/mailqueue" ? 1 : 0 );
  487.     $subst->{mail} = email_configuration_read();
  488.     $subst->{general}->{write_unavailable} = 0 + $subst->{mail}->{no_use};
  489.     $subst->{mail} = $subst->{guess} if ! defined $subst->{mail}->{net_SMTP};
  490.     $subst = options_email_config($subst);
  491.     screen_out("mailpop", $subst);
  492. }
  493.  
  494. ###
  495. ### options_mgr
  496. ###
  497. ### Displays the Options Manager
  498. ###
  499.  
  500. sub options_mgr {
  501.     my ($FORMref, $result, $stuff) = @_;
  502.     my $subst = {};
  503.     $subst->{general}->{username} = $result->[0]->{user};
  504.     $subst->{general}->{menu} = $FORMref->{menu};
  505.     $subst->{general}->{server_time} = time;
  506.     $subst->{stuff} = $stuff;
  507.     $subst->{general}->{url} = "$PARAMS->{cgiurl}?action=options_mgr&username=$FORMref->{username}";
  508.     $subst->{topics} = board_topics(undef, undef, undef, 1, 1);
  509.     foreach my $setting ('active_subs', 'active_subs_parents', 'reverse_subs', 'alphabet_subs', 'reverse_msgs') {
  510.         map $subst->{$setting}->{$_} = 1, split(/,/, $GLOBAL_OPTIONS->{$setting});
  511.     }
  512.     if ($DCONF->{pro}) {
  513.         dreq("bannedip-PRO");
  514.         $subst->{ipban} = read_ip_ban_file();
  515.         if (-e "$DCONF->{admin_dir}/msg_index/wordlist.txt") {
  516.             $subst->{general}->{dictionary_ready} = 1;
  517.             my $j = readfile("$DCONF->{admin_dir}/msg_index/wordlist.txt", "options_mgr", {no_lock => 1, no_unlock => 1, zero_ok => 1});
  518.             $subst->{general}->{spelling_words} = scalar(@{ $j });
  519.         } else {
  520.             $subst->{general}->{dictionary_ready} = 0;
  521.         }
  522.         dreq("fcn-prfl-PRO");
  523.         my @x = sort { $a->{order} <=> $b->{order} } @{ read_profile_fields() };
  524.         $subst->{fields} = \@x;
  525.         if ($FORMref->{menu} == 4 && $GLOBAL_OPTIONS->{login_message} ne "") {
  526.             dreq("webtags");
  527.             $subst->{special}->{login_message} = inverse_webtags($GLOBAL_OPTIONS->{login_message}, undef);
  528.         }
  529.         dreq("webtags");
  530.         $subst->{special}->{welcome_message} = inverse_webtags($GLOBAL_OPTIONS->{welcome_message}, undef);
  531.         for (my $i = 2; $i <= 10; $i++) {
  532.             my $x = join("", "status", $i);
  533.             $subst->{status}->{$x} = inverse_webtags($GLOBAL_OPTIONS->{$x}, undef);
  534.         }
  535.         dreq("fcn-grp");
  536.         my $g = read_group_file(1);
  537.         my @g = ();
  538.         my $l = {};
  539.         foreach my $_l (split(/,/, $GLOBAL_OPTIONS->{allusers_groups})) {
  540.             $l->{$_l} = 1;
  541.         }
  542.         foreach my $gr (@{ $g->{group_list} }) {
  543.             push @g, { name => $gr, selected => 0 + $l->{$gr} };
  544.         }
  545.         $subst->{groups} = \@g;
  546.         $subst->{allusers_groups}->{moderators} = 0 + $l->{'*mod*'};
  547.         $subst->{allusers_groups}->{users} = 0 + $l->{'*usr*'};
  548.         $subst->{general}->{allusers_total} = scalar keys %{$l};
  549.     }
  550.     if ($GLOBAL_OPTIONS->{advanced_options} == 0 && defined $GLOBAL_OPTIONS->{registered_min_msgsize} && ! defined $GLOBAL_OPTIONS->{basic_configured_defaults}) {
  551.         $GLOBAL_OPTIONS = options_save({ basic_configured_defaults => 1, advanced_options => 1 });        
  552.     }
  553.     if ($DCONF->{pro}) {
  554.         if (defined $GLOBAL_OPTIONS->{installed_gd}) {
  555.             $subst->{general}->{installed_gd} = 0 + $GLOBAL_OPTIONS->{installed_gd};
  556.         } else {
  557.             $GLOBAL_OPTIONS = options_save ({ installed_gd => 0 });
  558.             eval '
  559.                 use GD;
  560.                 my $smallimage = new GD::Image(50, 50);
  561.                 my $x = $smallimage->jpeg();
  562.             ';
  563.             if ($@ eq "") {
  564.                 $subst->{general}->{installed_gd} = 1;
  565.                 options_save ({ installed_gd => 1 });
  566.             }
  567.         }
  568.     }
  569.     $subst = options_email_config($subst) if $FORMref->{menu} == 6;
  570.     $subst->{general}->{pop_email_config} = 1 if $FORMref->{popconfig} == 1; 
  571.     if ($GLOBAL_OPTIONS->{advanced_options} == 1) {
  572.         if (-e "$DCONF->{admin_dir}/data/dtaskman.pid") {
  573.             my $pidf = readfile("$DCONF->{admin_dir}/data/dtaskman.pid", "options_mgr", { no_lock => 1, no_unlock => 1 });
  574.             my $pid = $pidf->[0]; chomp $pid;
  575.             if (kill(0, $pid) || $! == 1) {
  576.                 $subst->{general}->{taskman} = $pid;  ## Running
  577.             }
  578.         }
  579.         my @u = map { user => $_ }, split(/,/, $GLOBAL_OPTIONS->{debug_users});
  580.         $subst->{debug_users} = \@u;    
  581.         screen_out("options", $subst);
  582.     } else {
  583.         screen_out("optionsb", $subst);
  584.     }
  585. }
  586.  
  587. ###
  588. ### options_email_config
  589. ###
  590. ### Gets the current e-mail configuration by reading email.txt
  591. ###
  592.  
  593. sub options_email_config {
  594.     my ($subst, $L) = @_;
  595.     dreq("mailer");
  596.     my $email = email_configuration_read($L);
  597.     $subst->{general}->{net_SMTP} = $email->{net_SMTP};
  598.     $subst->{general}->{mail_program} = $email->{mail_program};
  599.     $subst->{general}->{SMTP} = $email->{SMTP};
  600.     $subst->{general}->{SMTP2} = $email->{SMTP2};
  601.     $subst->{general}->{SMTP3} = $email->{SMTP3};
  602.     $subst->{general}->{test_email_addr} = $email->{test_email_addr};
  603.     $subst->{mailer}->{chuckaddress} = $email->{chuckaddress};
  604.     $subst->{mailer}->{fromname} = $email->{fromname};
  605.     $subst->{mailer}->{fromaddr} = $email->{fromaddr};
  606.     eval 'use Net::SMTP;';
  607.     $subst->{mailer}->{net_smtp} = 1 if $@ eq "";
  608.     eval 'use Mail::Sendmail;';
  609.     $subst->{mailer}->{mail_sendmail} = 1 if $@ eq "";
  610.     $subst->{mailer}->{raw_socket} = -1;
  611.     eval 'use FileHandle;';
  612.     $subst->{mailer}->{raw_socket} += 1 if $@ eq "";
  613.     eval 'use Socket;';
  614.     $subst->{mailer}->{raw_socket} += 1 if $@ eq "";
  615.     $subst->{mailer}->{raw_socket} = 0 if $subst->{mailer}->{raw_socket} != 1;
  616.     eval 'use Net::POP3;';
  617.     $subst->{mailer}->{pop3} = 1 if $@ eq "";
  618.     return $subst;
  619. }
  620.  
  621. ###
  622. ### options_save
  623. ###
  624. ### Writes the options.txt file with new incoming options
  625. ###
  626.  
  627. sub options_save {
  628.     my ($new_options) = @_;
  629.     my $options_file = readfile("$DCONF->{admin_dir}/options.txt", "options_save", { zero_ok => 1, no_unlock => 1 });
  630.     undef my $seen;
  631.     foreach my $line (@{ $options_file }) {
  632.         my ($field, $value) = split(/=/, $line, 2);
  633.         my $field2 = $field;
  634.         $field2 =~ tr/a-zA-Z/b-zaB-Za/ if $new_options->{TRANSLATE_NAME};
  635.         if ($field =~ /^ip_(banned|comment)_\d/ && $GLOBAL_OPTIONS->{$field2} eq "" && $new_options->{$field2} eq "") {
  636.             $line = "";
  637.             next;
  638.         }
  639.         $seen->{$field} = 1;
  640.         $line = join("=", $field, join("", escape($new_options->{$field2}), "\n")) if defined $new_options->{$field2};
  641.     }
  642.     foreach my $x (keys(%{ $new_options })) {
  643.         next if $x eq "TRANSLATE_NAME";
  644.         my $y = $x;
  645.         $y =~ tr/b-zaB-ZA/a-zA-Z/ if $new_options->{TRANSLATE_NAME};
  646.         if ($seen->{$y} == 0) {
  647.             push (@{ $options_file }, join("", "$y=", escape($new_options->{$x}), "\n"));
  648.         }
  649.         $GLOBAL_OPTIONS->{$y} = $new_options->{$x};
  650.     }
  651.     my @o = sort @{ $options_file };
  652.     writefile("$DCONF->{admin_dir}/options.txt", \@o, "options_save", { no_lock => 1 });
  653.     unlink "$DCONF->{admin_dir}/data/dtaskman.pid";
  654.     unlink "$DCONF->{admin_dir}/data/schedule.pid";
  655.     if (defined $new_options->{skinchoice} && $GLOBAL_OPTIONS->{tcache} == 2) {
  656.         opendir(DIR, "$DCONF->{admin_dir}/data/tcache");
  657.         my @z = map { join("/", $DCONF->{admin_dir}, "data", "tcache", $_) } grep { /^SKIN.*\.pl$/ } readdir (DIR);
  658.         closedir(DIR);
  659.         unlink @z;
  660.         
  661.     }
  662.     return $GLOBAL_OPTIONS;
  663. }
  664.  
  665. 1;
  666.