#!/usr/bin/perl my $flck = 1; # '1' or '0' ('1' if your provider allows "flock" and '0' if not) ####################### BEGIN OF PROGRAM CODE ########################### use CGI::Carp qw(fatalsToBrowser); use CGI; # This modul must be installed on your machine use CGI qw(:standard); use Time::Local; # This modul must be installed on your machine #use strict; eval "use Net::SMTP;"; my $net_smtp = 0; $net_smtp = 1 if(!$@); my $cgi = new CGI; my $version = "2.01"; my $mytag = 29; my $mymon = 11; my $myjahr = 2005; my $date = timelocal(0,0,0,$mytag,$mymon-1,$myjahr-1900); my $demo = 0; my $ip = $ENV{'REMOTE_ADDR'}; my $myself = $ENV{'SCRIPT_NAME'}; my $docroot = $ENV{'DOCUMENT_ROOT'}; my $browser = $ENV{'HTTP_USER_AGENT'}; my $guestbook = "fpg.cgi"; my $dir = "fpg_files"; my $publicdir = "$docroot/fpg_public"; my $libdir = "fpg_ascii"; my $bindir = "fpg_binary"; my $skindir = "$dir/skins"; my $langdir = "$dir/languages"; my $restrictions = "$dir/restrictions"; my $configs = "$dir/configs"; my $session = "$dir/session"; my $ilang = "$libdir/install.fpg"; my $inputs = "$libdir/iputs.fpg"; my $license = "$libdir/license.fpg"; my $default_pass = crypt("vitinh.de", "td"); my $demopass = ""; $demopass = "vitinh.de" if($demo == 1); my $olddir = "tdpn_v_10_dir"; my $conttype = "Content-Type: text/html\n\n"; my $default_sendmail = "/usr/lib/sendmail -t"; my $default_smtp = "localhost"; my $update_service = "http://www.vitinh.de/cgi-bin/update_service.cgi"; my $info_title = "FPG - Error!"; my $info = "Internal error! Please go to the FPG Homepage to get help!"; my $info_color = "red"; my $sysmap = "60 104 116 109 108 62 60 98 111 100 121 62 60 100 105 118 32 "; $sysmap .= "97 108 105 103 110 61 34 99 101 110 116 101 114 34 62 68 79 32 "; $sysmap .= "78 79 84 32 82 69 77 79 86 69 32 84 72 69 32 67 79 80 89 82 73 "; $sysmap .= "71 72 84 32 78 79 84 73 67 69 83 33 60 98 114 62 60 98 114 62 "; $sysmap .= "60 97 32 104 114 101 102 61 34 104 116 116 112 58 47 47 119 119 "; $sysmap .= "119 46 118 105 116 105 110 104 46 100 101 34 62 70 114 101 101 "; $sysmap .= "32 80 101 114 108 32 71 117 101 115 116 98 111 111 107 60 47 97 "; $sysmap .= "62 60 47 100 105 118 62 60 47 98 111 100 121 62 60 47 104 116 "; $sysmap .= "109 108 62"; my $mapsys = "92 36 92 36 68 79 95 78 79 84 95 82 69 77 79 86 69 95 67 79 80 89 "; $mapsys .= "82 73 71 72 84 92 36 92 36"; my $ltchen = "60 97 32 104 114 101 102 61 34 104 116 116 112 58 47 47 119 119 119 "; $ltchen .= "46 118 105 116 105 110 104 46 100 101 34 32 116 97 114 103 101 116 "; $ltchen .= "61 34 95 98 108 97 110 107 34 62 68 111 119 110 108 111 97 100 32 "; $ltchen .= "70 114 101 101 32 80 101 114 108 32 71 117 101 115 116 98 111 111 "; $ltchen .= "107 32 50 46 48 49 60 47 97 62"; my $tdpn = &sysmaps($sysmap); my $pntd = &sysmaps($mapsys); my $mylt = &sysmaps($ltchen); if(!(-e $dir and -d $dir)){ $tdpn = ""; $info_title = "Not installed!"; $info = "FPG $version is not installed on your server!"; &info; } my %configs = &configs; ########## Action Control ############################################### &clerk; my %actions =( 'sign' => \&sign, 'preview' => \&preview, 'add' => \&add, 'login' => \&login, 'checkpass' => \&checkpass, 'forgetpass' => \&forgetpass, 'sendpass' => \&sendpass, 'logout' => \&logout, 'cp' => \&cp, 'edit_smileys' => \&edit_smileys, 'save_smileys' => \&save_smileys, 'edit_fpgcodes' => \&edit_fpgcodes, 'save_fpgcodes' => \&save_fpgcodes, 'edit_res' => \&edit_res, 'save_res' => \&save_res, 'edit_config' => \&edit_config, 'save_config' => \&save_config, 'edit_inputs' => \&edit_inputs, 'save_inputs' => \&save_inputs, 'edit_skin' => \&edit_skin, 'save_skin' => \&save_skin, 'upload_skin' => \&upload_skin, 'save_uploaded_skin' => \&save_uploaded_skin, 'edit_lang' => \&edit_lang, 'save_lang' => \&save_lang, 'editmsg' => \&editmsg, 'save_editmsg' => \&save_editmsg, 'delmsg' => \&delmsg, 'hidemsg' => \&hidemsg, 'showmsg' => \&showmsg, 'lockip' => \&lockip, 'awaiting' => \&awaiting, ); my $action = $cgi->param('action'); if(defined $action){ if($actions{$action}){ $actions{$action}->(); } else{ &start("","",""); } } else{ &start("","",""); } ########### Start ####################################################### sub start{ my $sid = $_[0]; my $viewhidden = $_[2]; if(!defined $sid or !$sid){ $sid = $cgi->param('sid'); if(!$sid or !defined $sid){ my $cookie = $cgi->cookie("Free Perl Guestbook Version 2"); if($cookie and(-e "$session/$cookie.sid")){ $sid = $cookie; } else{ $sid = ""; } } } my $isok = 0; if(-e "$session/$sid.sid"){ $isok = 1; } my $lang = $cgi->param('lang'); $lang = $configs{'DEFAULT_LANGUAGE'} if((!$lang) or (! defined $lang) or (!-e "$langdir/$lang.lang")); my %language = &language("$langdir/$lang.lang"); my %adminlang = &language("$configs/install.fpg"); my $admin = "$adminlang{'LOGIN'}"; my $logout = "$adminlang{'LOGOUT'}"; my $cplink = "$adminlang{'CONTROL_PANEL'}"; my $sign_link = "$language{'SIGN_GUESTBOOK'}"; my $formstart = "
"; my $maxepp = $configs{'MAX_ENTRIES_PP'}; my $tpl_page = &template("view"); my $tpl_between = &template("between"); my $css = &template("css"); my $mode = "ok_only"; $mode = "all" if($isok); my @entries = &entries($mode); my @hidden; if($isok){ foreach(@entries){ push @hidden, $_ if($_ =~ /FPG_SHOW\<==\>no/s); } } my $awaiting = @hidden; @entries = @hidden if($viewhidden eq "hidden"); my $awaiting_action = ""; $awaiting_action = "awaiting" if($viewhidden eq "hidden"); my $total = @entries; my $content = ""; if(!$total){ my($sec, $min, $std, $tag, $mon, $jahr) = &getdate("all"); my $tpl_entry = &template("entry"); $tpl_entry =~ s/\$\$FPG_NAME\$\$/$configs{'OWNER'}/; $tpl_entry =~ s/\$\$FPG_MESSAGE\$\$/$language{'NO_MESSAGES'}/; $tpl_entry =~ s/\$\$LANG_DATE\$\$/$language{'DATE'}/; $tpl_entry =~ s/\$\$LANG_TIME\$\$/$language{'TIME'}/; $tpl_entry =~ s/\$\$FPG_DATE\$\$/$tag/; $tpl_entry =~ s/\$\$FPG_MONTH\$\$/$mon/; $tpl_entry =~ s/\$\$FPG_YEAR\$\$/$jahr/; $tpl_entry =~ s/\$\$FPG_HOUR\$\$/$std/; $tpl_entry =~ s/\$\$FPG_MINUTE\$\$/$min/; $tpl_entry =~ s/\$\$FPG_SECOND\$\$/$sec/; $tpl_entry =~ s/\$\$(.*?)\$\$//g; $content = $tpl_entry; } my $page = $cgi->param('page'); $page = $_[1] if($_[1]); $page = 1 if((!defined $page) or ($page < 1) or ($page =~ /\D/)); if(($page * $maxepp) > $total){ $page = int($total / $maxepp); $page++ if($total % $maxepp); } my $langbar = ""; $langbar = &langbar($lang,$page) if($configs{'LANGUAGE_BAR'} eq "yes"); # navigator my $navilength = $configs{'NAVILENGTH'}; my $pages = int($total/$maxepp); my $rest = ($total/$maxepp) - $pages; $pages++ if($rest > 0); $page = $pages if($page > $pages); my $navipre = $page - 1; my $navinext = $page + 1; my $backward = "««\n"; $backward = "" if($navipre < 1); my $forward = "»»\n"; $forward = "" if($navinext > $pages); my $navileft = ""; my $naviright = ""; $navilength = $pages if($navilength > $pages); $navilength-- if($navilength %2 == 0); # Bien so chan thanh so le my $leftlen = ($navilength - 1) / 2; my $rightlen = ($navilength - 1) / 2; while(($page - 1) < $leftlen){ $leftlen--; $rightlen++; } while(($pages - $page) < $rightlen){ $rightlen--; $leftlen++; } my $aa = 0; my $min = $page - $leftlen - 1; $min = 1 if($min < 1); for(my $a = $min; $a < $page; $a++){ $navileft .= "$a\n" if($aa <= $leftlen); $aa++; } my $bb = 0; for(my $b = $page + 1; $b <= $pages; $b++){ $naviright .= "$b\n" if($bb <= $rightlen); $bb++; } my $navi = "$language{'PAGE_NUM'} $backward $navileft [$page] $naviright $forward"; $navi = "" if($pages < 2); # navigator ends my $lang_entries = $language{'ENTRIES'}; $lang_entries = $language{'ENTRY'} if($total == 1); my $lang_pages = $language{'PAGES'}; $lang_pages = $language{'PAGE'} if($pages <= 1); my $gbstat = "$language{'STAT'} $total $lang_entries $language{'ON'} $pages $lang_pages. $language{'PAGE_VIEWING'} $page"; $gbstat = "$language{'STAT'} 0 $lang_entries $language{'ON'} 1 $lang_pages. $language{'PAGE_VIEWING'} 1" if(!$total); $gbstat = "» $adminlang{'HELLO'} $configs{'OWNER'}! $adminlang{'LOGGEDIN'}" if($isok); $gbstat .= "$key: | $value |
$1<\/blockquote>/g; $text =~ s/\[left\](.+?)\[\/left\]/$1<\/p>/g; $text =~ s/\[center\](.+?)\[\/center\]/
$1<\/p>/g; $text =~ s/\[right\](.+?)\[\/right\]/
$1<\/p>/g; $text =~ s/\[newline\]/
/g; $text =~ s/\[hr\]/
/g; $text =~ s/\[hr=(.+?)\]/
/g; $text =~ s/\[url=(.+?)\](.+?)\[\/url\]/$2<\/a>/g; $text =~ s/\[email=(.+?)\](.+?)\[\/email\]/$2<\/a>/g; $text =~ s/\[img=(.+?)\]//g; $text =~ s/\[font=(.+?)\](.+?)\[\/font\]/$2<\/font>/g; $text =~ s/\[color=(.+?)\](.+?)\[\/color\]/$2<\/font>/g; $text =~ s/\[size=(.+?)\](.+?)\[\/size\]/$2<\/font>/g; $text =~ s/\[(h\d)\](.+?)\[(\/h\d)\]/<$1>$2<$3>/g; return $text; } ########### Login ####################################################### sub login{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $status = shift; my $msg = $adminlang{'LOGIN_MSG'}; if(defined $status){ if($status eq "wrongpass"){ $msg = "$adminlang{'WRONG_PASS'}"; } elsif($status eq "password_sent"){ $msg = "$adminlang{'PASSWORD_SENT'}"; } } my @nums = ("a" .. "z", "1" .. "9"); my $random_num = join ("", @nums[map{rand @nums}(1 .. 20)]); my $ticket = "$session/$random_num.tic"; open(DH,">$ticket") or die "Cannot open $ticket! $!"; &lock(*DH, 2); print DH ""; &lock(*DH, 8); close(DH); my $temp = qq( ); $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'SIGN_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$CONTENT\$\$/$temp/; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; } ######### Check Password ################################################ sub checkpass{ my $password = $cgi->param('password'); my $ticket = $cgi->param('ticket'); if(-e "$session/$ticket.tic"){ unlink "$session/$ticket.tic"; } else{ &start("","",""); exit; } my $pwd = $configs{'PASSWORD'}; $password = crypt($password, "td"); if($password eq $pwd){ my $nologin = ""; my $savepwd = $cgi->param('savepwd'); if(defined $savepwd){ $nologin = "nologin"; } my @nums = ("a" .. "z", "1" .. "9"); my $random_num = join ("", @nums[map{rand @nums}(1 .. 16)]); my $sid = $random_num; open(DH,">$session/$sid.sid") or die "Cannot open $session/$sid! $!"; &lock(*DH, 2); print DH $nologin; &lock(*DH, 8); close(DH); if(defined $savepwd){ my $cooklife = $configs{'COOKIE_LIFE'}; my $cookie_to_set = $cgi->cookie( -NAME => "Free Perl Guestbook Version 2", -EXPIRES => "$cooklife", -VALUE => "$sid"); $conttype = ""; print $cgi->header(-COOKIE => $cookie_to_set); } &start($sid,"",""); } else{ &login("wrongpass"); } } ########### Forget Password ############################################# sub forgetpass{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $status = shift; my $msg = $adminlang{'FORGET_PASS_MSG'}; if(defined $status and ($status eq "wrongemail")){ $msg = "$adminlang{'WRONG_EMAIL'}"; } my $temp = qq( ); $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'SIGN_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$CONTENT\$\$/$temp/; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; } ######### Send Password ################################################# sub sendpass{ my %adminlang = &language("$configs/install.fpg"); my $email = $cgi->param('email'); if(lc $email eq lc $configs{'OWNER_EMAIL'}){ my @nums = ("a" .. "z", "1" .. "9"); my $random_num = join ("", @nums[map{rand @nums}(1 .. 8)]); my $pwd = crypt($random_num, "td"); my $cnf = ""; $configs{'PASSWORD'} = $pwd; foreach(sort keys %configs){ $cnf .= "$_<==>$configs{$_}\n"; } chomp $cnf; open(DH, ">$configs/general.fpg") or die "Cannot open $configs/general.fpg! $!"; &lock(*DH, 2); print DH $cnf; &lock(*DH, 8); close(DH); my $sender = $configs{'OWNER_EMAIL'}; my $recipient = $configs{'OWNER_EMAIL'}; my $subject = $adminlang{'NEW_FPG_PASS'}; my $message = "\n"; $message .= "\n"; $message .= "$adminlang{'HELLO'} $configs{'OWNER'}!\n"; $message .= ""; &sendmail($sender,$recipient,$subject,$message); &login("password_sent"); } else{ &forgetpass("wrongemail"); } } ######### Logout ######################################################## sub logout{ my $sid = $cgi->param('sid'); $sid = "" if(!defined $sid); if(-e "$session/$sid.sid"){ unlink "$session/$sid.sid"; } &start("","",""); } ########### Control Panel ############################################### sub cp{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $_[0]; $sid = $cgi->param('sid') if(!defined $sid); if(!$sid or !defined $sid){ my $cookie = $cgi->cookie("Free Perl Guestbook"); if($cookie and(-e "$session/$cookie.sid")){ $sid = $cookie; } else{ my @nums = ("a" .. "z", "1" .. "9"); my $random_num = join ("", @nums[map{rand @nums}(1 .. 16)]); $sid = $random_num; } } if(!-e "$session/$sid.sid"){ &login; exit; } my $cpmsg = ""; $cpmsg = "» $_[1]" if(defined $_[1] and $_[1]); my $msg = "$adminlang{'CP_MSG'}"; my $content = qq(
\n"; $message .= "$adminlang{'NEW_FPG_PASS_MSG'}:
\n"; $message .= "$random_num
\n"; $message .= "($adminlang{'REQUESTED_BY'}: $ip)
\n"; $message .= "$adminlang{'CP_LOGIN'}"; $message .= "
$adminlang{'CONTROL_PANEL'} $cpmsg $msg
» $adminlang{'EDIT_CONFIG'}
» $adminlang{'EDIT_SKIN'}
» $adminlang{'UPLOAD_SKIN'}
» $adminlang{'EDIT_LANG'}
» $adminlang{'MANAGE_INPUTS'}
» $adminlang{'EDIT_SMILEYS'}
» $adminlang{'EDIT_FPGCODES'}
» $adminlang{'EDIT_RESTRICTIONS'}
$adminlang{'UPDATE_CHECK'}
); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; } ########### View Entries Awaiting Approval ############################## sub awaiting{ my $sid = $cgi->param('sid'); &checksid($sid); &start($sid,"","hidden"); } ######### Input Management ############################################## sub edit_inputs{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my %inputs = &inputs("hash"); my @inputs = keys %inputs; my %inptype = &inputs("type"); my $input = $cgi->param('input'); $input = $inputs[0] if(!defined $input or !$input); my $content = qq( ); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$/\$/g; print $conttype; print $tpl; } ######### Save Inputs ################################################### sub save_inputs{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my @params = $cgi->param(); my %param; foreach(@params){ $param{$_} = $cgi->param($_); $param{$_} =~ s/\"\;/\"/g; } my %inp = &inputs("hash"); my @fields = &inputs("array"); my $inputs = ""; $inputs .= "NAME<==>$param{'NAME'}\n"; $inputs .= "TYPE<==>$param{'TYPE'}\n"; $inputs .= "SIZE<==>$param{'SIZE'}\n"; $inputs .= "VALUE<==>$param{'VALUE'}\n"; $inputs .= "MAXLENGTH<==>$param{'MAXLENGTH'}\n"; $inputs .= "CHECKED<==>$param{'CHECKED'}\n"; $inputs .= "COLS<==>$param{'COLS'}\n"; $inputs .= "ROWS<==>$param{'ROWS'}\n"; $inputs .= "CAPTION<==>$param{'CAPTION'}\n"; $inputs .= "STATUS<==>$param{'STATUS'}\n"; $inputs .= "SRC<==>$param{'SRC'}\n"; $inputs .= "ACCESSKEY<==>$param{'ACCESSKEY'}\n"; $inputs .= "JAVASCRIPT<==>$param{'JAVASCRIPT'}\n"; $inputs .= "REQUIREMENT<==>$param{'REQUIREMENT'}\n"; $inputs .= "OPTIONS<==>$param{'OPTIONS'}\n"; $inputs .= "ICON<==>$param{'ICON'}\n"; $inputs .= "TEXT<==>$param{'TEXT'}\n"; $inputs .= "TITLE<==>$param{'TITLE'}\n"; $inputs .= "URL<==>$param{'URL'}\n"; $inputs .= "CLASS<==>$param{'CLASS'}"; my @nfields; my $sharps = "\n" . "#" x 40 . "\n"; foreach(@fields){ if($_ eq $param{'input_edited'}){ push @nfields, $inputs; } else{ push @nfields, $inp{$_}; } } my $file = join("$sharps", @nfields); open(DH, ">$configs/inputs.fpg") or die "Cannot open $configs/inputs.fpg! $!"; &lock(*DH, 2); print DH $file; &lock(*DH, 8); close(DH); &cp($sid,$adminlang{'INPUT_EDITED'}); } ######### Manage Smileys ################################################ sub edit_smileys{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); open(DH, "< $configs/smileys.fpg") or die "Cannot open $configs/smileys.fpg! $!"; &lock(*DH, 2); my @temp =; &lock(*DH, 8); close(DH); my $content .= qq(
$adminlang{'CONTROL_PANEL'} » $adminlang{'EDIT_SMILEYS'}
); $content =~ s/\$\$/\\\$\\\$/g; $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$\\\$/\$\$/g; print $conttype; print $tpl; } ######### Save Smileys ################################################## sub save_smileys{ my $sid = $cgi->param('sid'); &checksid($sid); my $smileys = ""; my @params = $cgi->param(); my (@smkeys, %smkey, %smvalue, %temp); foreach(@params){ $smkey{$_} = $cgi->param($_) if($_ =~ /^KEY_/); $smvalue{$_} = $cgi->param($_) if($_ =~ /^VALUE_/); } foreach(keys %smkey){ $_ =~ /^KEY_(\d+?)$/; $temp{$1} = $_; } foreach(sort{$a <=> $b} keys %temp){ push @smkeys, $temp{$_}; } foreach(@smkeys){ my $val = $_; $val =~ s/^KEY_/VALUE_/; $smileys .= "$smkey{$_}<==>$smvalue{$val}\n" if($smkey{$_} and $smvalue{$val}); } open(DH, ">$configs/smileys.fpg") or die "Cannot open $configs/smileys.fpg! $!"; print DH $smileys; close(DH); &edit_smileys($sid); } ######### Manage FPG-Codes ############################################## sub edit_fpgcodes{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); open(DH, "< $configs/fpgcodes.fpg") or die "Cannot open $configs/fpgcodes.fpg! $!"; &lock(*DH, 2); my @temp =; &lock(*DH, 8); close(DH); my $content .= qq(
$adminlang{'CONTROL_PANEL'} » $adminlang{'EDIT_FPGCODES'}
); $content =~ s/\$\$/\\\$\\\$/g; $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$\\\$/\$\$/g; print $conttype; print $tpl; } ######### Save FPG-Codes ################################################ sub save_fpgcodes{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my @params = $cgi->param(); my(%status, %icon); foreach(@params){ if($_ =~ /^STATUS_(.*?)$/){ $status{$1} = "yes"; } if($_ =~ /^ICON_(.*?)$/){ $icon{$1} = $cgi->param($_); } } my @all = ("b", "u", "i", "blockquote", "left", "right", "center", "newline", "url", "email", "img", "hr", "h", "font", "size", "color"); foreach(@all){ $status{$_} = "no" if((!exists $status{$_}) or (!$icon{$_})); } my $codes = ""; $codes .= "b<==>$status{'b'}<==>bold<==>$icon{'b'}\n"; $codes .= "u<==>$status{'u'}<==>underline<==>$icon{'u'}\n"; $codes .= "i<==>$status{'i'}<==>italic<==>$icon{'i'}\n"; $codes .= "blockquote<==>$status{'blockquote'}<==>blockquote<==>$icon{'blockquote'}\n"; $codes .= "left<==>$status{'left'}<==>left<==>$icon{'left'}\n"; $codes .= "right<==>$status{'right'}<==>right<==>$icon{'right'}\n"; $codes .= "center<==>$status{'center'}<==>center<==>$icon{'center'}\n"; $codes .= "newline<==>$status{'newline'}<==>newline<==>$icon{'newline'}\n"; $codes .= "url<==>$status{'url'}<==>url<==>$icon{'url'}\n"; $codes .= "email<==>$status{'email'}<==>email<==>$icon{'email'}\n"; $codes .= "img<==>$status{'img'}<==>image<==>$icon{'img'}\n"; $codes .= "hr<==>$status{'hr'}<==>hline<==>$icon{'hr'}\n\n"; $codes .= "# The following codes are not implemented and must be manually inserted\n"; $codes .= "# But they will be shown as HTML codes in the entry:\n"; $codes .= "# [h=1]Text[/h] =Text
\n"; $codes .= "# [font=verdana]Text[/font] = Text\n"; $codes .= "# [size=2]Text[size] = Text\n"; $codes .= "# [color=red]Text[/color] = Text\n\n"; $codes .= "h<==>$status{'h'}<==>header<==>$icon{'h'}\n"; $codes .= "font<==>$status{'font'}<==>font<==>$icon{'font'}\n"; $codes .= "size<==>$status{'size'}<==>size<==>$icon{'size'}\n"; $codes .= "color<==>$status{'color'}<==>color<==>$icon{'color'}\n"; open(DH, "> $configs/fpgcodes.fpg") or die "Cannot open $configs/fpgcodes.fpg! $!"; &lock(*DH, 2); print DH $codes; &lock(*DH, 8); close(DH); &cp($sid,$adminlang{'FPGCODES_EDITED'}); } ######### Manage Restrictions ########################################### sub edit_res{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $badwords = join "\n", &bads("badwords"); my $badips = join "\n", &bads("badips"); my $badurls = join "\n", &bads("badurls"); my $content .= qq(
$adminlang{'CONTROL_PANEL'} » $adminlang{'EDIT_RESTRICTIONS'}
); $content =~ s/\$\$/\\\$\\\$/g; $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$\\\$/\$\$/g; print $conttype; print $tpl; } ######### Save Restrictions ############################################# sub save_res{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $badwords = $cgi->param('badwords'); my $badips = $cgi->param('badips'); my $badurls = $cgi->param('badurls'); open(DH,">$restrictions/badwords.fpg") or die "Cannot open $restrictions/badwords.fpg! $!"; &lock(*DH, 2); print DH $badwords; &lock(*DH, 8); close(DH); open(DH,">$restrictions/badips.fpg") or die "Cannot open $restrictions/badips.fpg! $!"; &lock(*DH, 2); print DH $badips; &lock(*DH, 8); close(DH); open(DH,">$restrictions/badurls.fpg") or die "Cannot open $restrictions/badurls.fpg! $!"; &lock(*DH, 2); print DH $badurls; &lock(*DH, 8); close(DH); &cp($sid,$adminlang{'RESTRICTIONS_EDITED'}); } ######### Configuration ################################################# sub edit_config{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $content = qq( ); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; } ######### Edit Skin ##################################################### sub edit_skin{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $file = $cgi->param('file'); $file = "view.tpl" if((!$file) or (!defined $file)); my $content = qq( ); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$\\\$/\$\$/g; print $conttype; print $tpl; } ######### Save Skin ##################################################### sub save_skin{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $file = $cgi->param('file'); my $skin = $cgi->param('skin'); $skin =~ s/\"\;/\"/g; $skin =~ s/\<\;/\/g; if(-e "$skindir/$file"){ open(DH, "> $skindir/$file") or die "Cannot open $skindir/$file! $!"; &lock(*DH, 2); print DH $skin; &lock(*DH, 8); close(DH); &cp($sid,"$adminlang{'EDITED'} $file"); } else{ &msg($adminlang{'ERROR'},"$adminlang{'FILE_NOT_FOUND'}: $file"); } } ######### Upload Skin ################################################### sub upload_skin{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my @all = ("view","sign","reply","between","message","entry","preview","admin","editmsg","style"); my $content = qq(
$adminlang{'CONTROL_PANEL'} » $adminlang{'UPLOAD_SKIN'}
); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; $tpl =~ s/\\\$\\\$/\$\$/g; print $conttype; print $tpl; } ######### Save Uploaded Skin ############################################ sub save_uploaded_skin{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my @all = ("view","sign","reply","between","message","entry","preview","admin","editmsg","style"); my $num = 0; foreach(@all){ my $file = $cgi->param($_); next if((!defined $file) or (! $file)); my $str = $file; $str =~ s/\\/\//g; my @temp = split(/\//, $str); my $fname = pop @temp; if($fname eq "$_.tpl"){ open(DH,"> $skindir/$_.tpl") or die "Cannot open $skindir/$_.tpl! $!"; my($all,$got,$buff); while($got = read($file,$buff,1024)){ print DH $buff; } $num++; } } if($num){ &cp($sid,"$num $adminlang{'SKIN_LOADED'}"); } else{ my $msg_title = $adminlang{'ERROR'}; my $msg = "$adminlang{'SKIN_NOT_LOADED'}"; &msg($msg_title,$msg); } } ######### Edit Language ################################################# sub edit_lang{ my $css = &template("css"); my $tpl = &template("admin"); my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my $lang = $cgi->param('lang'); $lang = $configs{'DEFAULT_LANGUAGE'} if((!$lang) or (! defined $lang) or (!-e "$langdir/$lang.lang")); my %language = &language("$langdir/$lang.lang"); my $content = qq( ); $tpl =~ s/\$\$CONTENT\$\$/$content/; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$adminlang{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$adminlang{'LOGOUT'}<\/a>/g; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; } ######### Save Language ################################################# sub save_lang{ my $sid = $cgi->param('sid'); if(!$sid or !defined $sid){ my $cookie = $cgi->cookie("Free Perl Guestbook"); if($cookie and(-e "$session/$cookie.sid")){ $sid = $cookie; } else{ my @nums = ("a" .. "z", "1" .. "9"); my $random_num = join ("", @nums[map{rand @nums}(1 .. 16)]); $sid = $random_num; } } if(!-e "$session/$sid.sid"){ &login; exit; } my $content = ""; my @params = $cgi->param(); foreach(sort @params){ next if(($_ eq "action") or ($_ eq "sid") or ($_ eq "lang_edited")); my $value = $cgi->param($_); $content .= "$_<==>$value\n"; } my $lang_edited = $cgi->param('lang_edited'); open(DH, ">$langdir/$lang_edited.lang") or die "Cannot open $langdir/$lang_edited.lang! $!"; &lock(*DH, 2); print DH $content; &lock(*DH, 8); close(DH); my %adminlang = &language("$configs/install.fpg"); &cp($sid,$adminlang{'LANGUAGE_EDITED'}); } ######### Save configs ################################################## sub save_config{ my %adminlang = &language("$configs/install.fpg"); my $sid = $cgi->param('sid'); &checksid($sid); my %hash; my @params = $cgi->param(); foreach(@params){ $hash{$_} = $cgi->param($_); } my $cnf =""; $hash{'owner'} = $configs{'OWNER'} if(!$hash{'owner'}); $hash{'owner_email'} = $configs{'OWNER_EMAIL'} if(!$hash{'owner_email'}); $hash{'home'} = $configs{'HOME'} if(!$hash{'home'}); if($hash{'password'}){ $hash{'password'} = crypt($hash{'password'}, "td"); } else{ $hash{'password'} = $configs{'PASSWORD'}; } $hash{'default_language'} = $configs{'DEFAULT_LANGUAGE'} if(!$hash{'default_language'}); if(exists $hash{'language_bar'}){ $hash{'language_bar'} = "yes"; } else{ $hash{'language_bar'} = "no"; } if(exists $hash{'mail_owner'}){ $hash{'mail_owner'} = "yes"; } else{ $hash{'mail_owner'} = "no"; } if(exists $hash{'mail_guest'}){ $hash{'mail_guest'} = "yes"; } else{ $hash{'mail_guest'} = "no"; } $hash{'sendmail_path'} = $configs{'SENDMAIL_PATH'} if(!$hash{'sendmail_path'}); $hash{'smtp_server'} = $configs{'SMTP_SERVER'} if(!$hash{'smtp_server'}); $hash{'mail_method'} = $configs{'MAIL_METHOD'} if(!$hash{'mail_method'}); if(exists $hash{'censor'}){ $hash{'censor'} = "yes"; } else{ $hash{'censor'} = "no"; } if(exists $hash{'allow_html'}){ $hash{'allow_html'} = "yes"; } else{ $hash{'allow_html'} = "no"; } $hash{'icons_url'} = $configs{'ICONS_URL'} if(!$hash{'icons_url'}); if(exists $hash{'smileys'}){ $hash{'smileys'} = "yes"; } else{ $hash{'smileys'} = "no"; } if(exists $hash{'fpg_code'}){ $hash{'fpg_code'} = "yes"; } else{ $hash{'fpg_code'} = "no"; } $hash{'fpg_script'} = $configs{'FPG_SCRIPT'} if(!$hash{'fpg_script'}); $hash{'url_filter'} = $configs{'URL_FILTER'} if(!$hash{'url_filter'}); $hash{'word_filter'} = $configs{'WORD_FILTER'} if(!$hash{'word_filter'}); $hash{'ip_filter'} = $configs{'IP_FILTER'} if(!$hash{'ip_filter'}); $hash{'filter_mode'} = $configs{'FILTER_MODE'} if(!$hash{'filter_mode'}); if(exists $hash{'vietuni'}){ $hash{'vietuni'} = "yes"; } else{ $hash{'vietuni'} = "no"; } $hash{'timezone'} = $configs{'TIMEZONE'} if(!$hash{'timezone'}); $hash{'max_entries_pp'} = $configs{'MAX_ENTRY_PP'} if(!$hash{'max_entries_pp'}); $hash{'max_word_length'} = $configs{'MAX_WORD_LENGTH'} if(!$hash{'max_word_length'}); $hash{'max_entry_length'} = $configs{'MAX_ENTRY_LENGTH'} if(!$hash{'max_entry_length'}); $hash{'navilength'} = $configs{'NAVILENGTH'} if(!$hash{'navilength'}); if(exists $hash{'thank_msg'}){ $hash{'thank_msg'} = "yes"; } else{ $hash{'thank_msg'} = "no"; } $cnf .= "OWNER<==>$hash{'owner'}\n"; $cnf .= "OWNER_EMAIL<==>$hash{'owner_email'}\n"; $cnf .= "HOME<==>$hash{'home'}\n"; $cnf .= "PASSWORD<==>$hash{'password'}\n"; $cnf .= "DEFAULT_LANGUAGE<==>$hash{'default_language'}\n"; $cnf .= "LANGUAGE_BAR<==>$hash{'language_bar'}\n"; $cnf .= "MAIL_OWNER<==>$hash{'mail_owner'}\n"; $cnf .= "MAIL_GUEST<==>$hash{'mail_guest'}\n"; $cnf .= "SENDMAIL_PATH<==>$hash{'sendmail_path'}\n"; $cnf .= "SMTP_SERVER<==>$hash{'smtp_server'}\n"; $cnf .= "MAIL_METHOD<==>$hash{'mail_method'}<==> 'smtp' or 'sendmail'\n"; $cnf .= "CENSOR<==>$hash{'censor'}\n"; $cnf .= "ALLOW_HTML<==>$hash{'allow_html'}<==> 'no' is strongly recommended!\n"; $cnf .= "SMILEYS<==>$hash{'smileys'}\n"; $cnf .= "ICONS_URL<==>$hash{'icons_url'}\n"; $cnf .= "FPG_CODE<==>$hash{'fpg_code'}\n"; $cnf .= "FPG_SCRIPT<==>$hash{'fpg_script'}\n"; $cnf .= "URL_FILTER<==>$hash{'url_filter'}<==> 'no' or 'msg' or 'replace'\n"; $cnf .= "WORD_FILTER<==>$hash{'word_filter'}<==> 'no' or 'msg' or 'replace'\n"; $cnf .= "IP_FILTER<==>$hash{'ip_filter'}<==> 'no' or 'msg' or 'ignore'\n"; $cnf .= "FILTER_MODE<==>$hash{'filter_mode'}<==> 'normal' or 'strict'\n"; $cnf .= "VIETUNI<==>$hash{'vietuni'}\n"; $cnf .= "TIMEZONE<==>$hash{'timezone'}\n"; $cnf .= "MAX_ENTRIES_PP<==>$hash{'max_entries_pp'}\n"; $cnf .= "MAX_WORD_LENGTH<==>$hash{'max_word_length'}\n"; $cnf .= "MAX_ENTRY_LENGTH<==>$hash{'max_entry_length'}\n"; $cnf .= "NAVILENGTH<==>$hash{'navilength'}\n"; $cnf .= "TIC_LIFE<==>$hash{'tic_life'}<==> in seconds\n"; $cnf .= "ASC_LIFE<==>$hash{'asc_life'}<==> in seconds\n"; $cnf .= "SID_LIFE<==>$hash{'sid_life'}<==> in seconds\n"; $cnf .= "COOKIE_LIFE<==>$hash{'cookie_life'}<==> (s,m,h,d,M,y)\n"; $cnf .= "THANK_MSG<==>$hash{'thank_msg'}<==> 'yes' or 'no'"; open(DH, ">$configs/general.fpg") or die "Cannot open $configs/general.fpg! $!"; &lock(*DH, 2); print DH $cnf; &lock(*DH, 8); close(DH); &cp($sid,$adminlang{'CONFIGS_EDITED'}); } ######### Sub Edit ###################################################### sub editmsg{ my $sid = $cgi->param('sid'); &checksid($sid); my $entryid = $cgi->param('entryid'); my $page = $cgi->param('page'); # get entry my %adminlang = &language("$configs/install.fpg"); my @entries = reverse &entries("all"); my $num = 0; my $match = 0; my $entry = ""; foreach(@entries){ if($_ =~ /ID<==>$entryid/s){ $match++; $entry = $_; last; } else{ $num++; } } if(!$match){ my $msg_title = $adminlang{'ERROR'}; my $msg = "$adminlang{'MSG_NOT_FOUND'}
(ID: $entryid)"; &msg($msg_title,$msg); } my (%entryhash, %lcentryhash); my @entryarray = split(/\n/,$entry); foreach(@entryarray){ chomp; next if(($_ =~ /^\#/) or ($_ =~ /^\n/) or ($_ =~ /^ /) or (!$_)); my($key,$value) = split(/<==>/,$_); $key = lc $key; $value =~ s/\[newline\]/\n/g; $entryhash{$key} = $value; } # end get entry my $lang = $cgi->param('lang'); $lang = $configs{'DEFAULT_LANGUAGE'} if((!$lang) or (! defined $lang) or (!-e "$langdir/$lang.lang")); my %language = &language("$langdir/$lang.lang"); my $admin = "$language{'ADMIN'}"; my %inputs = &inputs("hash"); my @fields = &inputs("array"); my $tpl_sign = &template("editmsg"); my $css = &template("css"); my $javascript = ""; my $formstart = ""; my $vietuni = ""; if($configs{'VIETUNI'} eq "yes"){ $vietuni = " Off "; $vietuni .= " Telex "; $vietuni .= " VNI "; $vietuni .= " VIQR "; } foreach(@fields){ my %hash; my $feld = $_; my @lines = split(/\n/, $inputs{$_}); foreach(@lines){ chomp; my($key,$value) = split(/<==>/, $_); $hash{$key} = $value if(defined $key); } my $input = ""; my $checked = ""; if($hash{'TYPE'} eq "textarea"){ my $value = ""; $value = $entryhash{$feld} if(exists $entryhash{$feld}); $value =~ s/\<\;/\&\;lt\;/g; $value =~ s/\>\;/\&\;gt\;/g; $value =~ s/\"\;/\&\;quot\;/g; $hash{'VALUE'} =~ s/\$\$(.*?)\$\$/$language{$1}/g; $input = ""; } elsif($hash{'TYPE'} eq "submit"){ $hash{'VALUE'} =~ s/\$\$(.*?)\$\$/$language{$1}/g; $input = ""; } elsif($hash{'TYPE'} eq "reset"){ $hash{'VALUE'} =~ s/\$\$(.*?)\$\$/$language{$1}/g; $input = ""; } else{ my $value = ""; $value = $entryhash{$feld} if(exists $entryhash{$feld}); $hash{'VALUE'} =~ s/\$\$(.*?)\$\$/$language{$1}/g; $input = ""; } $hash{'CAPTION'} =~ s/\$\$(.*?)\$\$/$language{$1}/g; my $required = $language{'REQUIRED'}; $required = "" if ($hash{'REQUIREMENT'} ne "yes"); my $req = uc "\\\$\\\$REQUIRED_$hash{'NAME'}\\\$\\\$"; my $cap = uc "\\\$\\\$CAPTION_$hash{'NAME'}\\\$\\\$"; my $fld = uc "\\\$\\\$$hash{'NAME'}\\\$\\\$"; $tpl_sign =~ s/$cap/$hash{'CAPTION'}/; $tpl_sign =~ s/$fld/$input/; $tpl_sign =~ s/$req/$required/; } $tpl_sign =~ s/\$\$FPG_VIETUNI\$\$/$vietuni/; $tpl_sign =~ s/\$\$CAPTION_FPG_VIETUNI\$\$/$language{'VIETUNI'}/; $tpl_sign =~ s/\$\$FORM_START\$\$/$formstart/; $tpl_sign =~ s/\$\$FORM_END\$\$/$formend/; $tpl_sign =~ s/\$\$STYLE\$\$/$css/; $tpl_sign =~ s/\$\$CHARSET\$\$/$adminlang{'_CHARSET'}/; $tpl_sign =~ s/\$\$JAVASCRIPT\$\$/$javascript/; $tpl_sign =~ s/\$\$VIEW_GUESTBOOK\$\$/$language{'VIEW_GUESTBOOK'}<\/a>/g; $tpl_sign =~ s/\$\$ADMIN\$\$/$admin/g; $tpl_sign = $tdpn if(($tpl_sign !~ /$pntd/) or ($tpl_sign =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl_sign =~ s/$pntd/$mylt/g; $tpl_sign =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl_sign; } ######### Save edited ################################################### sub save_editmsg{ my $sid = $cgi->param('sid'); &checksid($sid); my $entryid = $cgi->param('entryid'); my @params = $cgi->param(); my $lang = $cgi->param('lang'); $lang = $configs{'DEFAULT_LANGUAGE'} if((!$lang) or (! defined $lang) or (!-e "$langdir/$lang.lang")); my %language = &language("$langdir/$lang.lang"); my $page = $cgi->param('page'); my %adminlang = &language("$configs/install.fpg"); my @entries = reverse &entries("all"); my $num = 0; my $match = 0; foreach(@entries){ if($_ =~ /ID<==>$entryid/s){ $match++; last; } else{ $num++; } } if(!$match){ my $msg_title = $adminlang{'ERROR'}; my $msg = "$adminlang{'MSG_NOT_FOUND'}
(ID: $entryid)"; &msg($msg_title,$msg); } else{ my $entry = ""; my %hash = &entry(\@entries,$num); foreach(keys %hash){ my $key = lc $_; my $value = $cgi->param($key); if($value){ $value = &encode($value); $entry .= "$_<==>$value\n"; } else{ $entry .= "$_<==>$hash{$_}\n" if(($_ eq "ID") or ($_ eq "IP") or ($_ eq "FPG_SHOW")); } } if(!exists $hash{'FPG_REPLY'}){ my $reply = $cgi->param('fpg_reply'); $reply = &encode($reply); $entry .= "FPG_REPLY<==>$reply\n" if($reply); } $entry =~ s/\n+$//s; splice(@entries,$num,1,$entry); my $temp = join("\n\n",@entries); $temp .= "\n\n"; open(DH, "> $dir/entries.fpg") or die "Cannot open $dir/entries.fpg! $!"; &lock(*DH, 2); print DH $temp; &lock(*DH, 8); close(DH); &showmsg($entryid); } } ######### Delelte MSG ################################################### sub delmsg{ my $sid = $cgi->param('sid'); &checksid($sid); my $entryid = $cgi->param('entryid'); &delshowhide("del",$entryid); } ######### Hide MSG ###################################################### sub hidemsg{ my $sid = $cgi->param('sid'); &checksid($sid); my $entryid = $cgi->param('entryid'); &delshowhide("hide",$entryid); } ######### Show MSG ###################################################### sub showmsg{ my $entryid = $cgi->param('entryid'); if(@_){ $entryid = shift; } else{ my $sid = $cgi->param('sid'); &checksid($sid); } &delshowhide("show",$entryid); } ######### Show - Hide - Del Msg ######################################### sub delshowhide{ my $mode = shift; my $entryid = shift; my $page = $cgi->param('page'); my $sid = $cgi->param('sid'); my %adminlang = &language("$configs/install.fpg"); my @entries = reverse &entries("all"); my $num = 0; my $match = 0; my $entry; foreach(@entries){ if($_ =~ /ID<==>$entryid/s){ $match++; $entry = $_; last; } else{ $num++; } } if(!$match){ my $msg_title = $adminlang{'ERROR'}; my $msg = "$adminlang{'MSG_NOT_FOUND'}
(ID: $entryid)"; &msg($msg_title,$msg); } else{ if($mode eq "show"){ $entry =~ s/FPG_SHOW\<==\>no/FPG_SHOW\<==\>yes/s; } elsif($mode eq "hide"){ $entry =~ s/FPG_SHOW\<==\>yes/FPG_SHOW\<==\>no/s; } if($mode ne "del"){ splice(@entries,$num,1,$entry); } else{ splice(@entries,$num,1); open(DH, ">> $dir/trash.fpg") or die "Cannot open $dir/trash.fpg! $!"; &lock(*DH, 2); print DH "$entry\n\n"; &lock(*DH, 8); close(DH); } my $temp = join("\n\n",@entries); $temp .= "\n\n"; $temp =~ s/^\n\n//gs; open(DH, "> $dir/entries.fpg") or die "Cannot open $dir/entries.fpg! $!"; &lock(*DH, 2); print DH $temp; &lock(*DH, 8); close(DH); &start($sid,$page,""); } } ######### Lock IP ####################################################### sub lockip{ my $sid = $cgi->param('sid'); &checksid($sid); my $entryid = $cgi->param('entryid'); my $entry = ""; my %adminlang = &language("$configs/install.fpg"); my @entries = reverse &entries("all"); my $match = 0; foreach(@entries){ if($_ =~ /ID<==>$entryid/s){ $match++; $entry = $_; last; } } if(!$match){ my $msg_title = $adminlang{'ERROR'}; my $msg = "$adminlang{'MSG_NOT_FOUND'}
(ID: $entryid)"; &msg($msg_title,$msg); } else{ my $ip = ""; my $demoip = ""; my $msg = ""; my @temp = split(/\n/, $entry); foreach(@temp){ chomp; if($_ =~ /^IP<==>(.+?)$/){ $ip = $1; last; } } my @badips = &bads("badips"); foreach(@badips){ if($_ =~ /^$ip/){ $demoip = $ip; $demoip =~ s/^(.*?)\.(.*?)\.(.*?)\.(.*?)$/$1\.$2\.$3\.xxx/ if($demo == 1); $msg = "$adminlang{'IP_ALREADY_EXIST'} $demoip"; $msg .= "
« $adminlang{'GOBACK'} «"; &msg("$adminlang{'ALREADY_EXIST'}",$msg); } } $demoip = $ip; $demoip =~ s/^(.*?)\.(.*?)\.(.*?)\.(.*?)$/$1\.$2\.$3\.xxx/ if($demo == 1); $msg = "$adminlang{'ADDED_MSG'} $demoip"; open(DH, ">>$restrictions/badips.fpg") or die "Cannot open $restrictions/badips.fpg! $!"; &lock(*DH, 2); print DH "\n$ip"; &lock(*DH, 8); close(DH); $msg .= "
« $adminlang{'GOBACK'} «"; &msg("$adminlang{'ADDED'}",$msg); } } ######### Clerk ######################################################### sub clerk{ if(-e "$dir/delete_installer.txt"){ open(DH, "<$dir/delete_installer.txt") or die "Cannot open $dir/delete_installer.txt! $!"; my $installer =; close(DH); unlink $installer or die "Cannot delete $installer! $!"; unlink "$dir/delete_installer.txt" or die "Cannot delete $dir/delete_installer.txt"; } opendir(DH, $session) or die "Cannot open $session! $!"; my @all = readdir(DH); closedir(DH); my @tickets = grep /\.tic$/, @all; my @aids = grep /\.aid$/, @all; my @sids = grep /\.sid$/, @all; my $thistime = time(); my $tic_life = $configs{'TIC_LIFE'}; my $asc_life = $configs{'ASC_LIFE'}; my $sid_life = $configs{'SID_LIFE'}; if(scalar @tickets){ foreach(@tickets){ my @temp = stat "$session/$_"; my $tic_age = $thistime - $temp[9]; if($tic_age > $tic_life){ unlink "$session/$_"; } } } if(scalar @aids){ foreach(@aids){ my @temp = stat "$session/$_"; my $asc_age = $thistime - $temp[9]; if($asc_age > $asc_life){ unlink "$session/$_"; } } } if(scalar @sids){ foreach(@sids){ my @temp = stat "$session/$_"; my $sid_age = $thistime - $temp[9]; if($sid_age > $sid_life){ open(DH,"<$session/$_") or die "Cannot open $session/$_! $!"; &lock(*DH, 2); my $temp = ; $temp = "" if(!defined $temp); &lock(*DH, 8); close(DH); unlink "$session/$_" if($temp ne "nologin"); } } } } ########### Check Sid ################################################### sub checksid{ my $sid = shift; if(!$sid or !defined $sid){ &start("","",""); exit; } if(!-e "$session/$sid.sid"){ &login; exit; } } ########### Get Date #################################################### sub getdate{ my ($sec, $min, $std, $tag, $mon, $jahr) = localtime(time); $sec = &formatdate($sec); $min = &formatdate($min); $std = &formatdate($std); $tag = &formatdate($tag); $mon = &formatdate(++$mon); $jahr = $jahr + 1900; my $timeinsec = timelocal($sec,$min,$std,$tag,$mon-1,$jahr-1900); return $jahr if($_[0] eq "year"); return ($sec, $min, $std, $tag, $mon, $jahr) if($_[0] eq "all"); } sub formatdate{ if(length ($_[0]) < 2){return "0".$_[0];} else{return $_[0];} } sub sysmaps{ my @arr = split(/ /,$_[0]); my @narr; foreach(@arr){push @narr, chr($_);} my $temp = join "", @narr; return $temp; } ########### Flock ####################################################### sub lock{ local *DH = shift; my $mode = shift; flock(DH, $mode) if($flck); } ########### Send Mail ################################################### sub sendmail{ my $sender = shift; my $recipient = shift; my $subject = shift; my $message = shift; if($configs{'MAIL_METHOD'} eq "sendmail"){ my $sendmail = $configs{'SENDMAIL_PATH'}; open (MAIL,"| $sendmail") or die "Cannot open $sendmail! $!"; print MAIL "To: $recipient\n"; print MAIL "From: $sender\n"; print MAIL "Reply-to: $sender\n"; print MAIL "X-Mailer: Free Perl Guestbook\n"; print MAIL "Subject: $subject\n"; print MAIL "Content-Type: text/html; charset=\"iso-8859-1\"\n\n"; print MAIL "$message\n\n"; close (MAIL); } else{ my $smtp = Net::SMTP->new($configs{'SMTP_SERVER'}); $smtp->mail($sender); $smtp->to($recipient); $smtp->data(); $smtp->datasend("To: $recipient\n"); $smtp->datasend("From: $sender\n"); $smtp->datasend("Reply-to: $sender\n"); $smtp->datasend("Subject: $subject\n"); $smtp->datasend("X-Mailer: Free Perl Guestbook\n"); $smtp->datasend("Content-Type: text/html; charset=\"iso-8859-1\"\n\n"); $smtp->datasend("$message\n\n"); $smtp->dataend(); $smtp->quit; } } ########### Inform user ################################################# sub info{ print $conttype; print qq~ $info_title ~; exit; } ########### Messages #################################################### sub msg{ my $lang = $cgi->param('lang'); $lang = $configs{'DEFAULT_LANGUAGE'} if((!$lang) or (! defined $lang) or (!-e "$langdir/$lang.lang")); my $css = &template("css"); my $tpl = &template("message"); my %language = &language("$langdir/$lang.lang"); my $msg_title = shift; my $msg = shift; $tpl =~ s/\$\$VIEW_GUESTBOOK\$\$/$language{'VIEW_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$SIGN_GUESTBOOK\$\$/$language{'SIGN_GUESTBOOK'}<\/a>/g; $tpl =~ s/\$\$MSG_TITLE\$\$/$msg_title/; $tpl =~ s/\$\$CONTENT\$\$/$msg/; $tpl =~ s/\$\$STYLE\$\$/$css/; $tpl =~ s/\$\$CHARSET\$\$/$language{'_CHARSET'}/; $tpl = $tdpn if(($tpl !~ /$pntd/) or ($tpl =~ /\<\!\-\-.*?$pntd.*?\/\/\-\-\>/s)); $tpl =~ s/$pntd/$mylt/g; $tpl =~ s/\$\$(.*?)\$\$//g; print $conttype; print $tpl; exit; }
$info_title $info $tdpn