#!/usr/local/bin/perl
# ----------------------------------------------------------------------------
# Page Publisher
# Developed by interactivetools.com, inc. <info@interactivetools.com>
# ----------------------------------------------------------------------------
# interactivetools.com is a new media software company which specializes in
# developing custom web based applications and publishing tools. We provide
# fast, friendly support and creative solutions for anyone doing business on
# the web. If you would like to find out how we can help you with your next
# internet project don't hesitate to contact us at info@interactivetools.com
# or visit our website at http://www.interactivetools.com/
# ----------------------------------------------------------------------------
($cgidir,$cgiurl)=&tl();unless($cgidir){print"Content-type: text/html\n\nUnable to determine cgidir!"; exit}%hd=("cgidir"=>$cgidir,"cgiurl"=>$cgiurl,"datadir"=>"$cgidir/data","filelock"=>"filelock.lock","tbcolor"=>"003399","bgcolor"=>"003366","product"=>"Page Publisher","ver"=>"1.22","prod_id"=>"11","prog_build"=>"***BUILD_NUMBER***","imageurl"=>"images/",);
$SIG{__DIE__}=$SIG{__WARN__}=\&sl;srand(time+$$+($$<<15));$|++;%hh=("datafile"=>"$hd{'datadir'}/page.dat","fields"=>"num name path url updated users allow_all_users","search"=>"name","sortcode"=>sub{
lc((split(/\¡/,$a,3))[1])cmp lc((split(/\¡/,$b,3))[1])});%ho=("datafile"=>"$hd{'datadir'}/setup.dat.cgi","fields"=>"num product ver titlebar tbcolor1 tbcolor2 tbcolor3 bgcolor1 bgcolor2 bgcolor3 imageurl "."helpurl client_id client_pw admin_id admin_pw login_timeout login_timeout_min logoff_action "."logoff_url client_add client_edithtml client_remove confirm_erase confirm_erased confirm_saved "."license_name license_domain license_id d c f demo footerbar branding perpage "."client_upload upload_max upload_max_filesize image_max image_max_width image_max_height upload_allowed_extensions upload_dir upload_url");%hn=("datafile"=>"$hd{'datadir'}/user.dat.cgi","search"=>"name","filelock"=>"filelock.lock","fields"=>"num name login_id login_pw created_mon created_day created_year expires_mon expires_day "."expires_year expires_date expires_never disabled notes","sortcode"=>sub{
lc((split(/\¡/,$a,3))[1])cmp lc((split(/\¡/,$b,3))[1])});%hm=("filelock"=>"filelock.lock","fields"=>"num url");sub sg{my($filelock)=$_[0]||"$hd{'datadir'}/$hd{'filelock'}";
my($i);my($pdir)=$filelock;$pdir=~s/\\/\//g;if($pdir=~m/^(.*?)[^\/]+$/&&!-w $1){&sz('dirnotwritable',$1)}if(-e $filelock&&(stat($filelock))[9]<$^T-300){&sz("persistentfilelock",$filelock)}
while(!mkdir($filelock,0777)){sleep 1;if(++$i>3){&sz('serverbusy')}}}sub si{my($filelock)=$_[0]||"$hd{'datadir'}/$hd{'filelock'}";
rmdir($filelock)}sub sa{if(ref($_[0])ne"HASH"){die"DB_Add : The first argument must be a HASH reference!\n"}if(ref($_[1])ne"HASH"){
die"DB_Add : The second argument must be a HASH reference!\n"}my($datafile)="$_[0]->{'datafile'}";my(@fields)=split(/ /,$_[0]->{'fields'});
my($in)=$_[1];my($newnum)=int$_[2];my(@aa);my(@ab);my(%hs);if((-e $datafile)&&$backup){&sb($_[0])}&sg();if(-e $datafile){
open(F,"<$datafile")||die("DB_Add : Error,Can't open '$datafile'.$!\n");@aa=<F>;close(F)}foreach(@aa){/^\d/||next;$hs{(split(/\¡/))[0]}=1}
if($newnum&&$hs{$newnum}){&si();return&sh(@_)}elsif($newnum){$nnum=$newnum}else{$nnum=1;while($hs{$nnum}){$nnum++}}open(F,">$datafile.tmp$$")||die("DB_Add : Can't create temp file $datafile.tmp$$.$!\n");
print F qq|#!$^X\n|;print F qq|print"Location: http://www.interactivetools.com/\\n\\n";\n__END__\n|;foreach(@aa){/^\d/||next;
s/[^¡]+$//;print F"$_\n"}my($line)="$nnum¡";for$i(1..$#fields){my($enc)=$in->{$fields[$i]};$enc=~s/([\x1a\r\n\¡\¿])/sprintf("¿%02x",ord($1))/egx;
$line.="$enc¡"}print F"$line\n";close(F)||die("DB_Add : Can't write $datafile : $!");rename("$datafile.tmp$$",$datafile)||die("DB_Add : Can't write $datafile : $!");
&si();return$nnum}sub sf{if(ref($_[0])ne"HASH"){die"DB_Load : The first argument must be a HASH reference!\n"}if(ref($_[1])ne"HASH"){
die"DB_Load : The second argument must be a HASH reference!\n"}if(!$_[2]){die"DB_Load : No record number was specified!\n"}
my($datafile)="$_[0]->{'datafile'}";my(@fields)=split(/ /,$_[0]->{'fields'});my($out)=$_[1];my($rnum)=int$_[2];my(@aa);my(@ab);
unless(-e $datafile){return(0)}if($_[0]->{'backup'}){&sb($_[0])}if(-e "$datafile"){&sg();open(F,"<$datafile")||die("DB_Load : Error,Can't open '$datafile'.$!\n");
@aa=<F>;close(F);&si()}foreach(@aa){/^$rnum\¡/||next;s/[^¡]+$//;undef %$out;@ab=split(/\¡/);for$i(0..$#fields){$out->{$fields[$i]}=$ab[$i];
$out->{$fields[$i]}=~s/¿([A-F0-9]{2})/pack("C",hex($1))/egix}return1}return0}sub sc{if(ref($_[0])ne"HASH"){die"DB_Del : The first argument must be a HASH reference!\n"}
if(!$_[1]){die"DB_Del : The second argument must be a record number!\n"}my($datafile)="$_[0]->{'datafile'}";my(@fields)=split(/ /,$_[0]->{'fields'});
my($rnum)=int$_[1];my(%hs);my($erased)=0;for(1..$#_){$hs{$_[$_]}++}my(@aa);unless(-e $datafile){return(0)}if($_[0]->{'backup'}){&sb($_[0])}
&sg();if(-e "$datafile"){open(F,"<$datafile")||die("DB_Del : Error,Can't open '$datafile'.$!\n");@aa=<F>;close(F)}open(F,">$datafile.tmp$$")||die("DB_Del : Can't create temp file $datafile.tmp$$.$!\n");
print F qq|#!$^X\n|;print F qq|print"Location: http://www.interactivetools.com/\\n\\n";\n__END__\n|;foreach(@aa){/^(\d+)\¡/||next;
if($hs{$1}){$erased++; next}s/[^¡]+$//;print F"$_\n"}close(F)||die("DB_Del : Can't write $datafile : $!");rename("$datafile.tmp$$",$datafile)||die("DB_Del : Can't write $datafile : $!");
&si();return$erased}sub sd{my($datafile)="$_[0]->{'datafile'}";my(@fields)=split(/ /,$_[0]->{'fields'});my($out)=$_[1];my($sortcode)=$_[2];
my($rowcode)=$_[3];my($rcount)=0;my(@aa);my(@ab);unless(defined &$rowcode){die("DB_List : no rowcode defined!")}unless(-e $datafile){
die("DB_List : $datafile does not exist!")}if($_[0]->{'backup'}){&sb($_[0])}&sg();open(F,"<$datafile")||die("DB_List : Can't open '$datafile'.$!\n");
@aa=<F>;close(F);&si();if($sortcode&&&$sortcode ne""){@aa=sort{&$sortcode} @aa}foreach(@aa){/^\d/||next;$rcount++;s/[^\¡]+$//;
undef %$out;@ab=split(/\¡/);for$i(0..$#fields){$out->{$fields[$i]}=$ab[$i];$out->{$fields[$i]}=~s/¿([A-F0-9]{2})/pack("C",hex($1))/egix}
if($rowcode){&$rowcode}}return($rcount)}sub se{if(ref($_[0])ne"HASH"){die"DB_ListPage : The first argument must be a HASH reference!\n"}
if(ref($_[1])ne"CODE"&&$_[1]){die"DB_ListPage : The second argument must be a CODE reference!\n"}if(ref($_[2])ne"CODE"&&$_[2]){
die"DB_ListPage : The third argument must be a CODE reference!\n"}if(ref($_[3])ne"CODE"&&$_[3]){die"DB_ListPage : The fourth argument must be a CODE reference!\n"}
if(ref($_[4])ne"HASH"&&$_[4]){die"DB_ListPage : The fifth argument must be a HASH reference!\n"}my($datafile)="$_[0]->{'datafile'}";
my(@fields)=split(/ /,$_[0]->{'fields'});my($querycode)=$_[1];my($matchcode)=$_[2];my($sortcode)=$_[3];my($out)=$_[4];my($perpage)=int$_[6];
my($pcount)=0;my($mcount)=0;my($rcount)=0;my($cpage)=int$_[5]||1;my($lpage)=0;my($npage)=0;my(@aa);my(@ab);unless(-e $datafile){
return(0,0,0,0,0,0)}if($_[0]->{'backup'}){&sb($_[0])}&sg();open(F,"<$datafile")||die("DB_List : Can't open '$datafile'.$!\n");
@aa=<F>;close(F);&si();if($sortcode&&&$sortcode ne""){@aa=sort{&$sortcode} @aa}foreach(@aa){/^\d/||next;$rcount++;s/[^\¡]+$//;
undef %$out;@ab=split(/\¡/);for$i(0..$#fields){$out->{$fields[$i]}=$ab[$i];$out->{$fields[$i]}=~s/¿([A-F0-9]{2})/pack("C",hex($1))/egix}
if(&$querycode()){$mcount++;my($thispage)=($mcount%$perpage) ?int($mcount/$perpage)+1 : $mcount/$perpage;if($thispage==$cpage){&$matchcode()}}}$pcount=int($mcount / $perpage);
if($mcount % $perpage){$pcount++}if(($cpage-1)<1||($cpage-1)>$pcount){$lpage=$pcount}else{$lpage=$cpage-1}if(($cpage+1)>$pcount){
$npage=1}else{$npage=$cpage+1}if(!$pcount){$cpage=$lpage=$npage=0}return($pcount,$mcount,$rcount,$cpage,$lpage,$npage)}sub sq{
my($in)=$_[0];my(@ar)=((A..Z,a..z,0..9),'+','/');my($out)=unpack("B*",$in);$out=~s/(\d{6}|\d+$)/$ar[ord(pack"B*","00$1")]/ge;
while(length($out)%4){$out.="="}return$out}sub sp{my($in)=$_[0];my(%if);my($out);for((A..Z,a..z,0..9),'+','/'){$if{$_}=$i++}$in=$_[0]||return"MIME64 : Nothing to decode";
$in=~s/[^A-Za-z0-9+\/]//g;$in=~s/([A-Za-z0-9+\/])/unpack"B*",chr($if{$1})/ge;$in=~s/\d\d(\d{6})/$1/g;$in=~s/(\d{8})/$out.=pack("B*",$1)/ge;
return$out}sub td{my($text)=$_[0];$text=~s/([^A-Za-z0-9\*\.\@\_\-])/uc sprintf('%%%02x',ord($1))/egx;$text=~tr/ /+/;return$text}
sub tc{my($text)=$_[0];$text=~tr/+/ /;$text=~s/%([A-F0-9]{2})/pack('C',hex($1))/egi;return$text}sub sh{if(ref($_[0])ne"HASH"){
die"DB_Save : The first argument must be a HASH reference!\n"}if(ref($_[1])ne"HASH"){die"DB_Save : The second argument must be a HASH reference!\n"}
if(!$_[2]){die"DB_Save : No record number was specified!\n"}my($datafile)="$_[0]->{'datafile'}";my(@fields)=split(/ /,$_[0]->{'fields'});
my($in)=$_[1];my($rnum)=int$_[2];my($saved)=0;my(@aa);my(@ab);if(!-e $datafile){return&sa(@_)}if($_[0]->{'backup'}){&sb($_[0])}
&sg();open(F,"<$datafile")||die("DB_Save : Error,Can't open '$datafile'.$!\n");@aa=<F>;close(F);open(F,">$datafile.tmp$$")||die("DB_Save : Can't create temp file $datafile.tmp$$.$!\n");
print F qq|#!$^X\n|;print F qq|print"Location: http://www.interactivetools.com/\\n\\n";\n__END__\n|;foreach(@aa){/^\d/||next;
if(/^$rnum\¡/){my($line)="$rnum¡";for$i(1..$#fields){my($enc)=$in->{$fields[$i]};$enc=~s/([\x1a\r\n\¡\¿])/sprintf("¿%02x",ord($1))/egx;
$line.="$enc¡"}print F"$line\n";$saved++;next}s/[^¡]+$//;print F"$_\n"}close(F)||die("DB_Save : Can't write $datafile : $!");
rename("$datafile.tmp$$",$datafile)||die("DB_Save : Can't write $datafile : $!");&si();unless($saved){return&sa(@_)}}sub sj{
my$str=$_[0];my$time=$_[1];my$GMT=$_[2];if(!$time||$time ne int($time)){returnundef}my($sec,$min,$hour,$day,$mon,$year,$wday);
if($GMT){($sec,$min,$hour,$day,$mon,$year,$wday)=gmtime($time)}else{($sec,$min,$hour,$day,$mon,$year,$wday)=localtime($time)}
my(%ib,%ic,%ia,%id);my(@ak)=qw(Sun Mon Tue Wed Thu Fri Sat);my(@aj)=qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
my(@ac)=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);my(@ag)=qw(January February March April May June July August September October November December);
foreach(@ak){$ib{lc$_}++}foreach(@aj){$ic{lc$_}++}foreach(@ac){$ia{lc$_}++}foreach(@ag){$id{lc$_}++}$str=~s/(\b[A-Za-z]{3,9}\b)/if($ib{
lc$1}){if(uc($1)eq$1){uc $ak[$wday]}elsif(lc($1)eq$1){lc$ak[$wday]}else{ucfirst lc$ak[$wday]}}elsif($ic{lc$1}){if(uc($1)eq$1){
uc $aj[$wday]}elsif(lc($1)eq$1){lc$aj[$wday]}else{ucfirst lc$aj[$wday]}}elsif($ia{lc$1}){if(uc($1)eq$1){uc $ac[$mon]}elsif(lc($1)eq$1){
lc$ac[$mon]}else{ucfirst lc$ac[$mon]}}elsif($id{lc$1}){if(uc($1)eq$1){uc $ag[$mon]}elsif(lc($1)eq$1){lc$ag[$mon]}else{ucfirst lc$ag[$mon]}}
else{$1}/ge;$str=~s/(\d{1,4}\b)/if(length $1==4){$year+1900}elsif(length $1<=2){if(substr($1,0,1)eq 0){sprintf("%02d",$day)}
else{$day}}else{$1}/ge;$str=~s/(\d{1,2})(st|nd|rd|th)/if($day==1||$day==21||$day==31){$day."st"}elsif($day==2||$day==22){
$day."nd"}elsif($day==3||$day==23){$day."rd"}else{$day."th"}/gei;$str=~s/SS/sprintf("%02d",$sec)/gei;$str=~s/MM/sprintf("%02d",$min)/gei;
$str=~s/HH/sprintf("%02d",$hour)/gei;return$str}sub f{my($script,@as)=@_;my$data;my$fh=do{local *F; *F};if(open($fh,"<$cgidir/$script")){<$fh>;
binmode($fh);$data.=join '',<$fh>;close($fh)}foreach(@as){if(open($fh,"<$cgidir/$_")){binmode($fh);$data.=join '',<$fh>;
close($fh)}}$data=~tr/\r\n//d;return(unpack('%32C*',$data))}sub tq{use Socket;my($reginfo);my$host=$ENV{'HTTP_HOST'}||$ENV{'SERVER_NAME'}||$ENV{'SERVER_ADDR'};
my$path=$ENV{'SCRIPT_NAME'}||$ENV{'PATH_INFO'};$reginfo.='&'.'reg1='.&td($hc{'license_name'});$reginfo.='&'.'reg2='.&td($hc{'license_domain'});
$reginfo.='&'.'lnum='.&td(&ug($hc{'license_id'}));$reginfo.='&'.'prog='.'pp';$reginfo.='&'.'ver='.&td($hd{'ver'});$reginfo.='&'.'url='.&td("$host$path");
$reginfo.='&'.'csum='.&td(&f($file));my$paddr=gethostbyname('www.interactivetools.com')||return;my$sock=&uw();socket ($sock,&PF_INET,&SOCK_STREAM,0)||die('No Socket: '.$!);
connect ($sock,pack "SnA4x8",&PF_INET,80,$paddr)||return;select ($sock); $|=1; select(STDOUT);print$sock "GET /register/register.cgi?$reginfo HTTP/1.0\n";
print$sock 'Referer: '.$ENV{'HTTP_REFERER'}."\n";print$sock 'User-Agent: itools_software'."\n\n";my$reply=join("",<$sock>);
close($sock);if($reply=~/itools\.license\.invalid/){$hc{'d'}=1}if($reply=~/itools\.license\.valid/){$hc{'d'}=0}&sh(\%ho,\%hc,1);
if($hc{'d'}){&sz('expired')}}sub ty{my$fh=&uw();my$filepath=shift;my$data;open($fh,"<$filepath")||return;binmode($fh);read($fh,$data,-s $fh);
close($fh);return$data}sub uw{local *F;return*F}sub sk{my$html=shift;$html=~s/&/&amp;/g;$html=~s/"/&quot;/g;$html=~s/</&lt;/g;
$html=~s/>/&gt;/g;return$html}sub tz{my($filename,$image_type)=@_;$image_type||=$filename;if($image_type=~/\.gif(\.|$)/i){
return&ua($filename)}elsif($image_type=~/\.jpe?g(\.|$)/i){return&uc($filename)}elsif($image_type=~/\.png(\.|$)/i){return&ud($filename)}
else{return()}}sub ud{my($filename)=@_;my($buf);open(PNG,$filename)||return(undef,undef,"PNG - Couldn't Open $filename");
binmode(PNG);seek(PNG,12,0);read(PNG,$buf,4);if($buf ne"IHDR"){close PNG; return(undef,undef,"PNG - Missing Image Header - $buf")}
read(PNG,$buf,8);close PNG;returnunpack("NN",$buf)}sub uc{my($filename)=@_;my($buf,$segheader,$marker,$code,$len);open(JPEG,$filename)||return(undef,undef,"JPEG - Couldn't Open $filename");
binmode(JPEG);read(JPEG,$buf,2);while(1){read(JPEG,$segheader,4);($marker,$code,$len)=unpack("a a n",$segheader);if($marker ne"\xFF"){
close JPEG; return(undef,undef,"JPEG - Marker not Found")}if((ord($code)>=0xC0)&&(ord($code)<=0xC3)){read(JPEG,$buf,5);close(JPEG);
my($y,$x)=unpack("xnn",$buf);return($x,$y)}else{read(JPEG,$buf,$len - 2)}}}sub ub{my($fh,$skip)=@_;my($lbuf);read($fh,$lbuf,$skip);
while(1){if(eof($fh)){close GIF; return(undef)}read($fh,$lbuf,1);last if ord($lbuf)==0;read($fh,$lbuf,ord($lbuf))}1}sub ua{
my($filename)=@_;my($buf,$type,$cmapsize,$mapdata,$x,$w,$y,$h);open(GIF,$filename)||return(undef,undef,"GIF - Couldn't Open $filename");
binmode(GIF);read(GIF,$type,6);read(GIF,$buf,7);if(length($buf)!=7){close GIF; return(undef,undef,"GIF - Corrupted Header")}($x)=unpack("x4 C",$buf);
if($x & 0x80){$cmapsize=3 * (2**(($x & 0x07)+1));read(GIF,$mapdata,$cmapsize);if(!$mapdata){close GIF; return(undef,undef,"GIF - Corrupted Colour Map")}}
while(1){if(eof(GIF)){close GIF; return(undef,undef,"GIF - EOF at BlockStart")}read(GIF,$buf,1);($x)=unpack("C",$buf);if($x==0x2c){
read(GIF,$buf,8);if(length($buf)!=8){close GIF; return(undef,undef,"GIF - Missing Image Header")}($x,$w,$y,$h)=unpack("x4 C4",$buf);
close(GIF);return($x+$w * 256,$y+$h * 256)}if($x==0x21){read(GIF,$buf,1);($x)=unpack("C",$buf);if($x==0xF9){read(GIF,$buf,6)}
elsif($x==0xFE){&ub(\*GIF,0)||return(undef,undef,"GIF - Bad Block - skip=0")}elsif($x==0x01){&ub(\*GIF,13)||return(undef,undef,"GIF - Bad Block - skip=13")}
elsif($x==0xFF){&ub(\*GIF,12)||return(undef,undef,"GIF - Bad Block - skip=12")}else{close GIF; return(undef,undef,"GIF - Unknown Block Extension")}}
else{close GIF;return(undef,undef,"GIF - Unknown Block Type")}}}1;@ac=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@ag=qw(January February March April May June July August September October November December);%hb=&su();%hq=&st();&ts();%hc=&sv();
if($hc{'ver'}<$hd{'ver'}){&tr($hc{'ver'})}if($ENV{'QUERY_STRING'}eq"r"){&tq()}if($hc{'d'}){$hd{'header_license_num'}=&ug($hc{'license_id'});
&sz('expired')}&ue();$hd{'header_license_name'}=$hc{'license_name'};$hd{'header_license_domain'}=$hc{'license_domain'};$hd{'header_license_num'}=&ug($hc{'license_id'});
if($hb{"logoff"}){&so}elsif($hb{"nojavascript"}){&sz('nojs')}elsif($hb{"about"}){&sz('about')}else{&sn}if($hc{'demo'}){if($hb{"demo_no_browse"}){&sz('demo_no_browse')}
if($hb{'browse'}&&$hb{'dir'}){&sz('demo_no_browse_redir')}if($hb{'setup_save'}){&sz('demo_no_setup_save')}if($hb{"page_add"}){&sz('demo_no_page_add')}
if($hb{"page_save"}){&sz('demo_no_page_add')}}if($hb{"editpage"}){&um()}if($hb{"savepage"}){&ur()}if($hd{'cuser_admin'}||$hc{'client_edithtml'}){
if($hb{"edithtml"}){&ul()}if($hb{"savehtml"}){&uq()}}if($hd{'cuser_admin'}||$hc{'client_remove'}){if($hb{"page_confirm_erase"}){&uk()}
if($hb{"page_erase"}){&un()}}if($hd{'cuser_admin'}||$hc{'client_add'}){if($hb{"page_add"}){&uj()}if($hb{"browse"}){&tw()}
if($hb{"page_save"}){&up()}}if($hb{"page_listall"}){&uo()}if($hb{"page_list"}){&uo()}if($hb{'browse_file'}){&tw()}if($hb{"add_image_select"}){&tu()}
if($hb{"add_image_select_save"}){&tv()}if($hb{"add_file_select"}){&tt()}if($hb{"add_file_select_save"}){&tv()}if($hb{"remove_image_select"}){&ut()}
if($hb{"remove_image_select_confirm"}){&uu()}if($hb{"remove_file_select"}){&ut()}if($hb{"remove_file_select_confirm"}){&uu()}
if($hd{'cuser_admin'}){if($hb{"setup_edit"}){&sx()}if($hb{"setup_save"}){&sy()}if($hb{'browse_file'}||$hb{'browse_dir'}){&tw()}
if($hb{"user_list"}||$hb{'user_keyname'}||$hb{'search_user_list'}||$hb{'user_listall'}){&tj()}if($hb{'user_add'}){&tf()}
if($hb{'user_edit'}){&th()}if($hb{'user_save'}){&tk()}if($hb{'user_confirm_erase'}){&tg()}if($hb{'user_erase'}){&ti()}if($hb{'page_settings_edit'}){&sr()}
if($hb{'page_settings_save'}){&ss()}}&uo;exit;sub sr{unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}
unless($hb{'page_settings_edit'}){die("Page_Settings_Edit : Page number not received from form.")}my(%ha);&ta('_page_menus.html');
&sf(\%hh,\%ha,$hb{'page_settings_edit'});if($hd{'cuser_admin'}){my$user_menu=&tm($ha{'users'});my$checked_radio='allow_all_users_checked_'.$ha{'allow_all_users'};
my%hz=('user_menu'=>$user_menu,$checked_radio=>' checked');$ha{'users'}=&tb('user_menu',\%hz);$ha{'name_he'}=&sk($ha{'name'});
$ha{'path_he'}=&sk($ha{'path'});$ha{'url_he'}=&sk($ha{'url'})}print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("edit_users",\%ha);exit}sub ss{if(!$hb{'name'}){$ha{'msg'}="You must specify a page name"}elsif(!$hb{'path'}){$ha{'msg'}="You must specify a filepath"}
elsif(!$hb{'url'}||$hb{'url'}eq"http://"){$ha{'msg'}="You must specify a page URL"}if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);
print&tb("showmsg",\%ha);exit}unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}unless($hb{'num'}){die("Page_Settings_Save : Page number not received from form.")}
my%ii;unless(&sf(\%hh,\%ii,$hb{'num'})){die("Page_Settings_Save : Invalid record number.")}$hb{'updated'}=$ii{'updated'};
&sh(\%hh,\%hb,$hb{'num'})}sub ti{unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}unless($hb{'num'}){
die("User_Erase : User record number not received from form.")}&sc(\%hn,$hb{'num'});my%hx;my$remove_user=sub{if($hx{'users'}=~s/(^|,)$hb{'num'},/$1/x){&sh(\%hh,\%hx,$hx{'num'})}};
&sd(\%hh,\%hx,undef,$remove_user);&tj()}sub tg{unless($hb{'user_confirm_erase'}){die("User_Confirm_Erase : User record number not received from form.")}
my%ha;&ta('_user_menus.html');unless(&sf(\%hn,\%ha,$hb{'user_confirm_erase'})){die("User_Confirm_Erase : User number not found in DB.")}
print"Content-type: text/html\n\n" unless($ContentType++);print&sm("confirm_erase",\%ha);exit}sub tk{unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}
my%ha=%hb;&ta('_user_menus.html');unless(length($ha{'name'})){$ha{'error'}=&tb('no_user_name')}unless(length($ha{'login_id'})){
$ha{'error'}.=&tb('no_login_name')}unless(length($ha{'login_pw'})){$ha{'error'}.=&tb('no_login_pw')}my$duplicate_username=0;
my%hi;if(lc($hb{'login_id'}eq lc($hc{'admin_id'}))){$duplicate_username=1} elsif($hb{'rnum'}){$check_login=sub{if(($hi{'num'}!=$hb{'rnum'})&&(lc($hb{'login_id'})eq lc($hi{'login_id'}))){
$duplicate_username=1}};&sd(\%hn,\%hi,undef,$check_login)}else{$check_login=sub{if(lc($hb{'login_id'})eq lc($hi{'login_id'})){
$duplicate_username=1}};&sd(\%hn,\%hi,undef,$check_login)}if($duplicate_username){$ha{'error'}.=&tb('duplicate_username')}
if($ha{'error'}){$ha{"created_mon_$ha{'created_mon'}_selected"}="selected";$ha{"created_day_$ha{'created_day'}_selected"}="selected";
$ha{"created_year_$ha{'created_year'}_selected"}="selected";$ha{"expires_mon_$ha{'expires_mon'}_selected"}="selected";$ha{"expires_day_$ha{'expires_day'}_selected"}="selected";
$ha{"expires_year_$ha{'expires_year'}_selected"}="selected";$ha{"expires_never_checked"}="checked"if$ha{'expires_never'};
$ha{"disabled_$ha{'disabled'}_checked"}="checked";$ha{'name_he'}=&sk($ha{'name'});$ha{'login_id_he'}=&sk($ha{'login_id'});
$ha{'login_pw_he'}=&sk($ha{'login_pw'});$ha{'notes_he'}=&sk($ha{'notes'});print"Content-type: text/html\n\n" unless($ContentType++);
if($hb{'rnum'}){print&sm("edit",\%ha)}else{print&sm("add",\%ha)}exit}else{my@am=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
$ha{'expires_date'}="$ha{'expires_day'} $am[$ha{'expires_mon'} - 1] $ha{'expires_year'}";if($hb{'rnum'}){&sh(\%hn,\%ha,$hb{'rnum'})}
else{&sa(\%hn,\%ha)}&tj()}}sub th{unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}&ta('_user_menus.html');
my%ha;unless(&sf(\%hn,\%ha,$hb{'user_edit'})){die("User_Edit : User number not found in DB.")}$ha{"created_mon_$ha{'created_mon'}_selected"}="selected";
$ha{"created_day_$ha{'created_day'}_selected"}="selected";$ha{"created_year_$ha{'created_year'}_selected"}="selected";$ha{"expires_mon_$ha{'expires_mon'}_selected"}="selected";
$ha{"expires_day_$ha{'expires_day'}_selected"}="selected";$ha{"expires_year_$ha{'expires_year'}_selected"}="selected";$ha{"expires_never_checked"}="checked"if$ha{'expires_never'};
$ha{"disabled_$ha{'disabled'}_checked"}="checked";$ha{'name_he'}=&sk($ha{'name'});$ha{'login_id_he'}=&sk($ha{'login_id'});
$ha{'login_pw_he'}=&sk($ha{'login_pw'});$ha{'notes_he'}=&sk($ha{'notes'});print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("edit",\%ha);exit}sub tf{unless($hd{'cuser_admin'}){&sl('Must be logged in as administrator.')}&ta('_user_menus.html');
my($day,$mon,$year)=(localtime)[3,4,5];$mon++; $year+=1900;$ha{'created_day_'.$day.'_selected'}='selected';$ha{'created_mon_'.$mon.'_selected'}='selected';
$ha{'created_year_'.$year.'_selected'}='selected';$year++;$ha{'expires_day_'.$day.'_selected'}='selected';$ha{'expires_mon_'.$mon.'_selected'}='selected';
$ha{'expires_year_'.$year.'_selected'}='selected';print"Content-type: text/html\n\n" unless($ContentType++);print&sm("add",\%ha);
exit}sub tj{unless($hd{'cuser_admin'}){&sl("Must be logged in as administrator.")}my($sortcode)=${'hn'}{'sortcode'}||die("User_List : no sort routine defined\n");
my(@an)=split(/ /,${'hn'}{'search'});&ta('_user_menus.html');my(%he,%ha);$perpage=$hc{"perpage"}||10;$pagenum=$hb{'pagenum'}||$hq{"user_pagenum"}||1;
if(defined $hb{'user_keyname'}){$user_keyname=$hb{'user_keyname'}; $pagenum=1}else{$user_keyname=$hq{"user_keyname"}}if($hb{"user_listall"}){
$user_keyname=""; $pagenum=1}&sw("user_pagenum",$pagenum);&sw("user_keyname",$user_keyname);$ha{'user_keyname_he'}=&sk($user_keyname);
my%hi;my$user_match_code=sub{if($hi{'expires_never'}){$hi{'expires'}='Never'}else{$hi{'expires'}=$hi{'expires_date'}}$ha{'list'}.=&tb("user",\%hi)};
my$keyname_query=sub{return(!length($user_keyname)||$hi{'name'}=~/$user_keyname/i)};($ha{'pcount'},$ha{'mcount'},$ha{'rcount'},$ha{'cpage'},$ha{'lpage'},$ha{'npage'})=&se(\%{'hn'},$keyname_query,$user_match_code,$sortcode,\%hi,$pagenum,$perpage);
unless($ha{'list'}){$ha{'list'}=&tb("not_found")}print"Content-type: text/html\n\n" unless($ContentType++);print&sm("list",\%ha);
exit}sub tm{my$page_users=$_[0]||0;my%ha;my$options;my$rowcode;if($page_users){$rowcode=sub{$options.=qq|<option value="$ha{'num'}|.',"';
$options.=' selected'if($page_users=~/(^|,)$ha{'num'},/x);$options.=">$ha{'name'}</option>\n"}}else{$rowcode=sub{$options.=qq|<option value="$ha{'num'}|.',"';
$options.=">$ha{'name'}</option>\n"}}my($sortcode)=${'hn'}{'sortcode'}||die("sub tm : no sort routine defined.\n");my$user_count=&sd(\%hn,\%ha,$sortcode,$rowcode);
if($user_count){$user_menu=qq|<select name="users" size="10" multiple>\n$options</select>|}else{$user_menu="No Users"}return$user_menu}
sub ue{if(!$f){exit}$cgidir2=lc$cgidir;$cgidir2=~s/[^\w-]//g;if($hc{'c'}eq unpack("%32C*",$cgidir2)||$hc{'demo'}){return}
&ta("_install_menus.html");if($hb{'cancel'}){print"Location: http://www.interactivetools.com/\n\n"; exit}if($hb{'finish'}){&uf}
if($hb{'browse_file'}||$hb{'browse_dir'}){&tw()}print"Content-type: text/html\n\n" unless($ContentType++);if($hb{'step6'}){
if($hb{'client_upload'}){$hc{'client_upload'}=1}else{$hc{'client_upload'}=0}if($hb{'client_upload'}){if(defined($hb{'upload_dir'})&&length($hb{'upload_dir'})){
if($hb{'upload_dir'}!~/\/$/){$hb{'upload_dir'}.="/"}}unless(-e $hb{'upload_dir'}){$error='Upload directory does not exist!<br>'}
if(defined($hb{'upload_url'})&&length($hb{'upload_url'})){if($hb{'upload_url'}!~/\/$/){$hb{'upload_url'}.="/"}}if($hb{'upload_url'}!~m|^https?://|i){
$error.='Upload URL must begin with "http" or "https"<br>'}}$hc{'upload_dir'}=$hb{'upload_dir'};$hc{'upload_url'}=$hb{'upload_url'};
&sh(\%ho,\%hc,1);if($error){$content=&tb('error');print&ta('_install_menus.html');exit}$content=&tb("step6",\%hc)}elsif($hb{'step5'}){
if(defined $hb{'imageurl'}){if($hb{'imageurl'}!~/\/$/){$hb{'imageurl'}.="/"}$hc{'imageurl'}=$hb{'imageurl'}}&sh(\%ho,\%hc,1);
$content=&tb("step5",\%hc)}elsif($hb{'step4'}){if(defined $hb{'license_id'}){if(!&uy($hb{'license_id'})){$error="Invalid Product ID!<br>"}
if(!$hb{'license_id'}){$error="You must enter your Product ID!<br>"}if(!$hb{'license_domain'}){$error="You must enter your domain name!<br>"}
if(!$hb{'license_name'}){$error="You must enter your company name!<br>"}if($error){$content=&tb("error");print&ta("_install_menus.html");
exit}}if(defined $hb{'license_name'}){$hc{'license_name'}=$hb{'license_name'};$hc{'license_domain'}=$hb{'license_domain'};
$hc{'license_id'}=$hb{'license_id'};&sh(\%ho,\%hc,1)}%ha=('imageurl'=>$hd{'imageurl'},'upload_dir'=>$hc{'upload_dir'},'upload_url'=>$hc{'upload_url'});
if($hc{'client_upload'}){$ha{'client_upload_1_checked'}='checked'}$content=&tb("step4",\%ha)} elsif($hb{'step4a'}){$images_url=$hb{'imageurl'};
if($images_url!~/\/$/){$images_url.="/"}$content=&tb("step4a")} elsif($hb{'step3'}){undef $hc{'license_id'};$content=&tb("step3",\%hc)}
elsif($hb{'step2'}){$content=&tb("step2")}else{$content=&tb("step1")}print&ta("_install_menus.html");exit}sub uf{if(!$hb{'admin_id'}||!$hb{'admin_pw'}){
print"Content-type: text/html\n\n" unless($ContentType++);$error="You must enter a username and password!";$content=&tb("error");
print&ta("_install_menus.html");exit}if(!&uy($hc{'license_id'})){$error="Please go back and enter a valid Product ID!<br>"}
if(!$hc{'license_id'}){$error="Please go back and enter your Product ID!<br>"}if(!$hc{'license_domain'}){$error="Please go back and enter your domain name!<br>"}
if(!$hc{'license_name'}){$error="Please go back and enter your company name!<br>"}if($error){$content=&tb("error");print"Content-type: text/html\n\n" unless($ContentType++);
print&ta("_install_menus.html");exit}$cgidir2=lc$cgidir;$cgidir2=~s/[^\w-]//g;$hc{'c'}=unpack("%32C*",$cgidir2);$hc{'admin_id'}=$hb{'admin_id'};
$hc{'admin_pw'}=$hb{'admin_pw'};&sh(\%ho,\%hc,1);&sw('cookies','yes');&tq();print"Content-type: text/html\n\n" unless($ContentType++);
&ta("_interface.html");print&tb("login",\%ha);&ux();exit}sub uy{local($k,@af,%ig,@ad,$q1n,$q2s,$q3s,$q4s,$q5s);$k=uc$_[0];
$k=~s/[^A-Z0-9\-]//gs;if(!$k){return(0)}if($k!~/^\w{4}-\w{4}-\w{4}-\w{4}-\w{4}$/){return(0)}if($k=~/0000/){return(0)}my$n=-1;
foreach(split(//,"0123456789ABC"."DEFGHJKMNPQRSTUVWXYZ")){$ig{$_}=++$n;$af[$n]=$_}my(@ad)=split(/\-/,$k);for(0..3){$q1n+=$ig{(reverse split(//,$ad[0]))[$_]}*33**$_}
for(3,2,1,0){$q2s.=$af[int($q1n<<11)/33**$_%33||0];$q3s.=$af[int($q1n<<12)/33**$_%33||0];$q4s.=$af[int($q1n<<13)/33**$_%33||0];
$q5s.=$af[int($q1n<<14)/33**$_%33||0]}return(!($q1n%47)&&$q2s eq$ad[1]&&$q3s eq$ad[2]&&$q4s eq$ad[3]&&$q5s eq$ad[4])}sub uo{
my($sortcode)=${'hh'}{'sortcode'}||die("page_list : no sort routine defined\n");my(@an)=split(/ /,${'hh'}{'search'});&ta("_page_menus.html");
my(%he,%ha);$perpage=$hc{"perpage"}||10;$pagenum=$hb{'pagenum'}||$hq{"page_pagenum"}||1;if(defined $hb{'keyword'}){$keyword=$hb{'keyword'}; $pagenum=1}
else{$keyword=$hq{"page_keyword"}}if($hb{"page_listall"}){$keyword=""; $pagenum=1}&sw("page_pagenum",$pagenum);&sw("page_keyword",$keyword);
$ha{'keyword'}=$keyword;$query=sub{unless($hd{'cuser_admin'}){return(1)if$he{'allow_all_users'};my%hj=map{$_,1} split(/,/,$he{'users'});
my$this_user=$hd{'unum'};return(0) unless $hj{$this_user}}foreach$field(@an){if($keyword&&$he{$field}=~/\Q$keyword\E/i){
return(1)}}if($keyword){return(0)}else{return(1)}};$result=sub{if($he{'updated'}){$he{'updated'}=&sj('Sep 30th,&nbsp;2000 - HH:MM:SS',$he{'updated'})}
else{$he{'updated'}="Never"}if($hd{'cuser_admin'}||$hc{'client_edithtml'}){$he{'link_list'}.=&tb('link_div');$he{'link_list'}.=&tb('link_edithtml',\%he)}
if($hd{'cuser_admin'}||$hc{'client_remove'}){$he{'link_list'}.=&tb('link_div');$he{'link_list'}.=&tb('link_remove',\%he)}
if($hd{'cuser_admin'}){$he{'link_list'}.=&tb('link_div');$he{'link_list'}.=&tb('link_page',\%he)}$ha{'list'}.=&tb("row",\%he)};
if($hd{'cuser_admin'}||$hc{'client_add'}){$ha{'add_button'}.=&tb('add_button')}($ha{'pcount'},$ha{'mcount'},$ha{'rcount'},$ha{'cpage'},$ha{'lpage'},$ha{'npage'})=&se(\%{'hh'},$query,$result,$sortcode,\%he,$pagenum,$perpage);
unless($ha{'list'}){$ha{'list'}=&tb("not_found")}print"Content-type: text/html\n\n" unless($ContentType++);print&sm("list",\%ha);
exit}sub um{&ta("_page_menus.html");my($num)=$thispagenum=int$hb{"editpage"};&sf(\%hh,\%ha,$num)||die("page_editpage : Can't find record # $num\n");
unless($hd{'cuser_admin'}||$ha{'allow_all_users'}){my$current_user=$hd{'unum'};my$allowed_users=$ha{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);
&sl("Access denied.") unless $hj{$current_user}}if(!-f $ha{'path'}){$ha{'msg'}="Couldn't find '$ha{'name'}' page.The following<br>file could not be found on the server:<br>$ha{'path'}"}
elsif(!-r $ha{'path'}){$ha{'msg'}="Couldn't read '$ha{'name'}' page.Please ask your server<br>adminstrator to make the following file readable:<br>$ha{'path'}"}
elsif(!-w $ha{'path'}){$ha{'msg'}="Couldn't write '$ha{'name'}' page.Please ask your server<br>adminstrator to make the following file wriout:<br>$ha{'path'}"}
if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}if($ha{'updated'}){
$ha{'updated'}=&sj('Sep 30th,2000 - HH:MM:SS',$ha{'updated'})}else{$ha{'updated'}="Never"}open(F,"<$ha{'path'}");while(<F>){
$html.=$_}close(F);@fields=($html=~m|<!--\s*publish\s*.*?\s*-->.*?<!--\s*/publish\s*-->|gsi);my%ht;foreach(@fields){if(!m|<!--\s*publish\s*(.*?)\s*-->(.*?)<!--\s*/publish\s*-->|is){
next}$attr=$1;$value=$2;$n++;if($attr=~/name="(.*?)"/i){$name=$1}else{$name="Field $n"}if($attr=~/type="(text|textfield|field)"/i){
$type="text"}elsif($attr=~/type="(email|emaillink)"/i){$type="email";if($value=~/href="mailto:(.*?)">(.*?)<\/a/i){($email,$value)=($1,$2)}
else{$value=~s/<[^>]*>//g}}elsif($attr=~/type="(link|url)"/i){$type="link";if($value=~/href="(.*?)">(.*?)<\/a/i){($link,$value)=($1,$2)}
else{$value=~s/<[^>]*>//g}}elsif($attr=~/type="(image|img)"/i){$type="image";if($value=~/src="(.*?)"/i){$value=$1}}elsif($attr=~/type="(textarea|textbox)"/i){
$type="textarea"}elsif($attr=~/type="wysiwyg"/i){$type="wysiwyg"}elsif($attr=~/type="image_select"/i){$type="image_select"}
elsif($attr=~/type="file_select"/i){$type="file_select"}else{$type="textarea"}if($attr=~/rows="?(\d+)"?/){$rows=$1}else{
$rows=5}local($html_checked,$text_checked);if($attr=~/format="html"/i){$format="html"}elsif($attr=~/format="text"/i){$format="text"}
elsif($type eq'wysiwyg'){$format='html'}else{$format="text"}${"$format"."_checked"}="checked";if($type=~/_select/){$uploaddir=$allowupload=$allowremove='';
if($attr=~/uploaddir="(.*?)"/i){$uploaddir=$1}if($attr=~/allowupload="(.*?)"/i){$allowupload=$1}if($allowupload=~/^[y1]/i){
$allowupload=1}else{$allowupload=0}if($attr=~/allowremove="(.*?)"/i){$allowremove=$1}if($type=~/image/){$options=&tp('image',$uploaddir,$value);
$ht{'u'.$uploaddir}.="[$n,true]"}else{$options=&tp('file',$uploaddir,$value);$ht{'u'.$uploaddir}.="[$n,false]"}if($value=~m|<a.*?>(.*?)</a>|i){
$tag_link_text=$1}else{$tag_link_text='File'}if($allowremove=~/^[y1]/i){$remove_button=&tb('remove_button')}else{$remove_button=''}}
if($type=~/textarea|wysiwyg/&&$format eq"text"){$value=~s/\n//gs;$value=~s/<br>/\n/gsi;$value=~s/<p>/\n\n/gsi}$value=~s/&/&amp;/gs;
$value=~s/"/&quot;/gs;$value=~s/</&lt;/gs;$value=~s/>/&gt;/gs;$ha{'list'}.=&tb($type);if($type eq'wysiwyg'){$ha{'wysiwyg_javascript'}.=&tb('wysiwygJS',{
n=>$n})}}$ha{'list'}||=&tb("nofields");foreach$key(keys %ht){$ht{$key}=~s/\]\[/\],\[/g;$ha{'select_array'}.="upload_dirs[upload_dirs.length]=[$ht{
$key}];\n"}print"Content-type: text/html\n\n" unless($ContentType++);print&sm("editpage",\%ha);exit}sub tp{my($select_type,$uploaddir,$tag_content)=@_;
my$options=qq|<option value="">None</option>\n|;$uploaddir=~s|\.{2}||g;$uploaddir=~s|^[\/]+||;$uploadurl=$hc{'upload_url'}.$uploaddir;
$uploaddir=$hc{'upload_dir'}.$uploaddir;$uploaddir=~s|([^/])$|$1/|;$uploadurl=~s|([^/])$|$1/|;my@ae;if(opendir(DIR,"$uploaddir")){@ae=grep{!/^(urllist\.dat\.cgi(\.clean)?)$/&&-f "$uploaddir$_"} readdir(DIR);
close(DIR)}my$URL;if($select_type eq'image'){$tag_content=~/src\s*=\s*("|')?(.*?)(\1|\s)/i; $URL=$2}else{$tag_content=~/href\s*=\s*("|')?(.*?)(\1|\s)/i; $URL=$2}
my($URL_dir,$URL_file)=$URL=~m|^(.*/)([^/]+)$|;if($select_type eq'image'){@ae=grep{/\.(gif|jpe?g|png|bmp)$/i} @ae}if(scalar(@ae)){
if($select_type eq'image'){$options.=qq|<option value="">--- Uploaded Images ---</option>\n|}else{$options.=qq|<option value="">--- Uploaded Files ---</option>\n|}
my$filename;foreach$filename(sort @ae){my$filename_value_he=&sk($filename);if(($URL_dir eq$uploadurl)&&($URL_file eq$filename)&&($tag_content!~/^\s*<!--/)){
$selected=' selected'}else{$selected=''}if(length($filename)>35){$filename=substr($filename,0,10).'...'.substr($filename,-25)}
my$filename_text_he=&sk($filename);$options.=qq|<option value="$filename_value_he"$selected>$filename_text_he</option>\n|}}$hm{'datafile'}=$uploaddir.'urllist.dat.cgi';
my(@ah,%hr);if(-e "$hm{'datafile'}"){&sd(\%hm,\%hr,undef,sub{push(@ah,$hr{'url'})})}if($select_type eq'image'){@ah=grep{/\.(gif|jpe?g|png|bmp)$/i} @ah}
if(scalar(@ah)){my($link,@al,$ref);foreach$link(@ah){push(@al,[$link,$link])}foreach$ref(@al){$ref->[1]=~s|^\w+?://||i;if(length($ref->[1])>35){
$ref->[1]=substr($ref->[1],0,10).'...'.substr($ref->[1],-25)}}if($select_type eq'image'){$options.=qq|<option value="">--- Image Links ---</option>\n|}
else{$options.=qq|<option value="">--- File Links ---</option>\n|}foreach$ref(sort{$a->[1]cmp$b->[1]} @al){my$imagelink_value_he=&sk($ref->[0]);
my$imagelink_text_he=&sk($ref->[1]);if(($URL eq$ref->[0])&&($tag_content!~/^\s*<!--/)){$selected=' selected'}else{$selected=''}$options.=qq|<option value="$imagelink_value_he"$selected>$imagelink_text_he</option>\n|}}
return$options}sub to{my($PML_tag,$old_content,$menu_choice)=@_;unless(length($menu_choice)){if($old_content=~/^\s*<!--/){
return$old_content}else{return"<!-- $old_content -->"}}my$new_content=$old_content;$new_content=~s/^\s*<!-- (.*) -->\s*$/$1/s;
my($attr)=$PML_tag=~/<!--\s*publish\s*(.*?)\s*-->/i;if($menu_choice=~m|^\w+://|){unless($new_content=~s!src\s*=\s*('|").*?\1!src=$1$menu_choice$1!i){
$new_content=qq|<img src="$menu_choice" border="0">|}}else{if(($attr=~/uploaddir="(.*?)"/)&&length($1)){$uploaddir=$1;$uploaddir=~s|\.{2}||g;
$uploaddir=~s|^[\/]+||;$uploadurl=$hc{'upload_url'}.$uploaddir}else{$uploadurl=$hc{'upload_url'}}$uploadurl=~s|([^/])$|$1/|;
unless($new_content=~s!src\s*=\s*('|").*?\1!src=$1$uploadurl$menu_choice$1!i){$new_content=qq|<img src="$uploadurl$menu_choice" border="0">|}}
return$new_content}sub tn{my($PML_tag,$old_content,$menu_choice,$link_text)=@_;unless(length($menu_choice)){if($old_content=~/^\s*<!--/){
return$old_content}else{return"<!-- $old_content -->"}}$link_text='File' unless length($link_text);my$new_content=$old_content;
$new_content=~s/^\s*<!-- (.*) -->\s*$/$1/s;my($attr)=$PML_tag=~/<!--\s*publish\s*(.*?)\s*-->/i;if($menu_choice=~m|^\w+://|){
unless($new_content=~s!href\s*=\s*('|").*?\1(.*?)>.*?</a>!href=$1$menu_choice$1$2>$link_text</a>!i){$new_content=qq|<a href="$menu_choice">$link_text</a>|}}
else{if(($attr=~/uploaddir="(.*?)"/)&&length($1)){$uploaddir=$1;$uploaddir=~s|\.{2}||g;$uploaddir=~s|^[\/]+||;$uploadurl=$hc{'upload_url'}.$uploaddir}
else{$uploadurl=$hc{'upload_url'}}$uploadurl=~s|([^/])$|$1/|;unless($new_content=~s!href\s*=\s*('|").*?\1(.*?)>.*?</a>!href=$1$uploadurl$menu_choice$1$2>$link_text</a>!i){
$new_content=qq|<a href="$uploadurl$menu_choice">$link_text</a>|}}return$new_content}sub tu{my%ha=%hb;$ha{'page_title'}='Add';
&ta('_select_menus.html');$ha{'_content'}=&tb('add_image_select',\%ha);print"Content-type: text/html\n\n" unless($ContentType++);
print&ta('_select_menus.html',\%ha);exit}sub tv{unless(($hb{'fieldnum'}=~/^\d+$/)&&($hb{'thispagenum'}=~/^\d+$/)){&te('non-integer fieldnum/thispagenum.')}
if($hb{'upload'}){unless($hc{'client_upload'}){&te('File uploading disallowed by setup!')}unless(length($hb{'ufile_select'})){&te('Upload radio button chosen but no file received!')}}
my%ha=%hb;&sf(\%hh,\%hf,$hb{'thispagenum'})||&te("Can't find record # $num\n");if(!-f $hf{'path'}){$ha{'msg'}="Couldn't find '$hf{'name'}' page.The following<br>file could not be found on the server:<br>$hf{'path'}"}
elsif(!-r $hf{'path'}){$ha{'msg'}="Couldn't read '$hf{'name'}' page.Please ask your server<br>adminstrator to make the following file readable:<br>$hf{'path'}"}
elsif(!-w $hf{'path'}){$ha{'msg'}="Couldn't write '$hf{'name'}' page.Please ask your server<br>adminstrator to make the following file writable:<br>$hf{'path'}"}
if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}open(F,"<$hf{'path'}");
while(<F>){$html.=$_}close(F);@fields=($html=~m|<!--\s*publish\s*.*?\s*-->.*?<!--\s*/publish\s*-->|gsi);foreach(@fields){
if(!m|<!--\s*publish\s*(.*?)\s*-->(.*?)<!--\s*/publish\s*-->|is){next}$attr=$1;$ha{'n'}++;last if($ha{'n'}==$hb{'fieldnum'})}
if(($attr=~/uploaddir="(.*?)"/)&&length($1)){$uploaddir=$1;$uploaddir=~s|\.{2}||g;$uploaddir=~s|^[\/]+||;$uploaddir=$hc{'upload_dir'}.$uploaddir;
$uploaddir=~s|([^/])$|$1/|}else{$uploaddir=$hc{'upload_dir'}}if($hb{'upload'}){unless(length($attr)&&($attr=~/type="(image|file)_select"/i)&&($attr=~/allowupload="(.*?)"/i)&&($1=~/^[y1]/i)){&te('Uploading is not allowed for this field.')}
unless(-d $uploaddir){&te('Upload directory does not exist!')}unless(length($hb{'ufile_select_ext'})&&($hc{'upload_allowed_extensions'}=~/(^|,| )$hb{'ufile_select_ext'}(,|$)/i)){&te("$hb{'ufile_select_ext'} file type not allowed!")}$ha{'add_to_image_selects'}='false';
my$ext=lc$hb{'ufile_select_ext'};if(length($hb{'ufile_select_ext'})&&($ext eq'gif'||$ext eq'jpg'||$ext eq'jpeg'||$ext eq'png'||$ext eq'bmp')){
$ha{'add_to_image_selects'}='true'} elsif($hb{'add_image_select_save'}){&te("$hb{'ufile_select_ext'} image type not allowed!")}
if($hc{'upload_max'}){my$max_bytes=$hc{'upload_max_filesize'} * 1024;if(length($hb{'ufile_select'})>$max_bytes){&te("Filesize exceeds maximum allowed size of $hc{'upload_max_filesize'} K!")}}
unless(length($hb{'ufile_select_file'})){&te('Filename not read from form data.')}$ha{'ufile_select_file'}=~s/[^a-zA-Z0-9_\.-]/_/g;
unless(-w $uploaddir){&te('Upload directory does not allow saving!<br>Please ask your server administrator to make this directory writable.')}
if(-e "$uploaddir$ha{'ufile_select_file'}"){&te('A file with the same name already on server.<br>Please rename it!')}unless(open(F,">$uploaddir$ha{'ufile_select_file'}")){&te('Unable to save image to server!')}
binmode(F);print F$ha{'ufile_select'}||&te('Unable to save image to server!');close(F);if($hc{'image_max'}&&$hb{'add_image_select_save'}){
my($width,$height,$error)=&tz("$uploaddir$ha{'ufile_select_file'}");if($width&&$height){if(($width>$hc{'image_max_width'})||($height>$hc{'image_max_height'})){
unlink("$uploaddir$ha{'ufile_select_file'}");&te("Image exceeds maximum width of $hc{'image_max_width'} and/or height of $hc{'image_max_height'}!")}}}$ha{'page_title'}='Added';
$ha{'message'}='File Added';$ha{'option_val'}=$ha{'ufile_select_file'};$ha{'option_text'}=$ha{'ufile_select_file'};$ha{'option_text'}=~s|^\w+?://||i;
if(length($ha{'option_text'})>35){$ha{'option_text'}=substr($ha{'option_text'},0,10).'...'.substr($ha{'option_text'},-25)}$ha{'file_upload'}='true'}
else{unless(-d $uploaddir){&te('Upload directory does not exist!')}unless($ha{'url'}=~m!^(http|ftp)s?://!i){&te('Only absolute Web or FTP URLs are supported.<br>URL must begin with http(s):// or ftp(s)://','Invalid URL')}
my($linked_ext)=$ha{'url'}=~/^[^?#]*\.([^?#]*)/;unless(length($linked_ext)&&($hc{'upload_allowed_extensions'}=~/(^|,| )$linked_ext(,|$)/i)){&te("$linked_ext file type not allowed!",'Invalid URL')}$ha{'add_to_image_selects'}='false';
my$ext=lc$linked_ext;if(length($linked_ext)&&($ext eq'gif'||$ext eq'jpg'||$ext eq'jpeg'||$ext eq'png'||$ext eq'bmp')){$ha{'add_to_image_selects'}='true'} elsif($hb{'add_image_select_save'}){&te("$linked_ext image type not allowed!")}$hm{'datafile'}=$uploaddir.'urllist.dat.cgi';
my$duplicate=0;if(-e "$hm{'datafile'}"){&sd(\%hm,\%hr,undef,sub{$duplicate++if$hr{'url'}eq$ha{'url'}})}if($duplicate){&te('URL already listed!','Duplicate URL')}
&sa(\%hm,\%ha,undef);$ha{'page_title'}='Added';$ha{'message'}='URL Added';$ha{'option_val'}=$ha{'option_text'}=$ha{'url'};
$ha{'option_text'}=~s|^\w+?://||i;if(length($ha{'option_text'})>35){$ha{'option_text'}=substr($ha{'option_text'},0,10).'...'.substr($ha{'option_text'},-25)}$ha{'file_upload'}='false'}
&ta('_select_menus.html');$ha{'_content'}=&tb('add_confirmation',\%ha);print"Content-type: text/html\n\n" unless($ContentType++);
print&ta('_select_menus.html',\%ha);exit}sub te{$ha{'message'}=shift;$ha{'page_title'}=shift||'Upload Error';&ta('_select_menus.html');
$ha{'_content'}=&tb('upload_error',\%ha);print"Content-type: text/html\n\n" unless($ContentType++);print&ta('_select_menus.html',\%ha);
exit}sub ut{my%ha=%hb;$ha{'page_title'}='Confirm Removal';$ha{'remove_this'}=&sk($ha{'choice'});$ha{'remove_this_short'}=$ha{'choice'};
if(length($ha{'remove_this_short'})>35){$ha{'remove_this_short'}=~s|^\w+?://||i;$ha{'remove_this_short'}=substr($ha{'remove_this_short'},0,10).'...'.substr($ha{'remove_this_short'},-25)}$ha{'remove_this_short'}=&sk($ha{'remove_this_short'});
$ha{'remove_message'}='Are you sure you want to remove this?';&ta('_select_menus.html');if($hb{'remove_image_select'}){$ha{'_content'}=&tb('remove_image_select',\%ha)}
else{$ha{'_content'}=&tb('remove_file_select',\%ha)}print"Content-type: text/html\n\n" unless($ContentType++);print&ta('_select_menus.html',\%ha);
exit}sub uu{unless(($hb{'fieldnum'}=~/^\d+$/)&&($hb{'thispagenum'}=~/^\d+$/)){&te('non-integer fieldnum/thispagenum.')}my%ha=%hb;
&sf(\%hh,\%hf,$hb{'thispagenum'})||&te("Can't find record # $num\n");if(!-f $hf{'path'}){$ha{'msg'}="Couldn't find '$hf{'name'}' page.The following<br>file could not be found on the server:<br>$hf{'path'}"}
elsif(!-r $hf{'path'}){$ha{'msg'}="Couldn't read '$hf{'name'}' page.Please ask your server<br>adminstrator to make the following file readable:<br>$hf{'path'}"}
elsif(!-w $hf{'path'}){$ha{'msg'}="Couldn't write '$hf{'name'}' page.Please ask your server<br>adminstrator to make the following file writable:<br>$hf{'path'}"}
if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}open(F,"<$hf{'path'}");
while(<F>){$html.=$_}close(F);@fields=($html=~m|<!--\s*publish\s*.*?\s*-->.*?<!--\s*/publish\s*-->|gsi);foreach(@fields){
if(!m|<!--\s*publish\s*(.*?)\s*-->(.*?)<!--\s*/publish\s*-->|is){next}$attr=$1;$ha{'n'}++;last if($ha{'n'}==$hb{'fieldnum'})}
unless(($attr=~/allowremove="(.*?)"/i)&&($1=~/^[y1]/i)){&te('You are not allowed to remove this file!','Removal Denied')}
if(($attr=~/uploaddir="(.*?)"/)&&length($1)){$uploaddir=$1;$uploaddir=~s|\.{2}||g;$uploaddir=~s|^[\/]+||;$uploaddir=$hc{'upload_dir'}.$uploaddir;
$uploaddir=~s|([^/])$|$1/|}else{$uploaddir=$hc{'upload_dir'}}unless(-d $uploaddir){&te('Upload directory does not exist!')}$hm{'datafile'}=$uploaddir.'urllist.dat.cgi';
if($ha{'remove_this'}=~m|^\w+://|i){&sd(\%hm,\%hr,undef,sub{if($hr{'url'}eq$hb{'remove_this'}){&sc(\%hm,$hr{'num'})}});$ha{'page_title'}='Removed';
$ha{'message'}='Link has been removed.';$ha{'file_upload'}='false'}else{$ha{'remove_this'}=~s|/\\||g;unlink("$uploaddir$ha{'remove_this'}");
$ha{'page_title'}='Removed';$ha{'message'}='File has been removed from server.';$ha{'update_image_select'}='true';$ha{'file_upload'}='true'}
&ta('_select_menus.html');$ha{'_content'}=&tb('remove_confirmation',\%ha);print"Content-type: text/html\n\n" unless($ContentType++);
print&ta('_select_menus.html',\%ha);exit}sub tt{my%ha=%hb;$ha{'page_title'}='Add';&ta('_select_menus.html');$ha{'_content'}=&tb('add_file_select',\%ha);
print"Content-type: text/html\n\n" unless($ContentType++);print&ta('_select_menus.html',\%ha);exit}sub ur{&ta("_page_menus.html");
my($num)=int$hb{'num'};if($num){&sf(\%hh,\%ha,$num);unless($hd{'cuser_admin'}||$ha{'allow_all_users'}){my$current_user=$hd{'unum'};
my$allowed_users=$ha{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);&sl("Access denied.") unless $hj{$current_user}}$ha{'updated'}=time();
&sh(\%hh,\%ha,$num)}open(F,"<$ha{'path'}");while(<F>){$html.=$_}close(F);$html=~s/(<!--\s*publish\s*.*?\s*-->)(.*?)(<!--\s*\/publish\s*-->)/$stag=$1;
$tcontent=$2;$etag=$3;$n++;if(defined $hb{"field$n"}){$val=$hb{"field$n"}}elsif(defined $hb{"email$n"}){$val=$hb{"email$n"}}
elsif(defined $hb{"link$n"}){$val=$hb{"link$n"}}elsif(defined $hb{"image$n"}){$val=$hb{"image$n"}}if(defined $hb{"field$n"}){
$val=$val}elsif($hb{"email$n"}){$val=qq|<a href="mailto:$val">$hb{"name$n"}<\/a>|}elsif($hb{"link$n"}){$val=qq|<a href="$val">$hb{"name$n"}<\/a>|}
elsif($hb{"image$n"}){$val=qq|<img src="$val" border=0 alt="">|}if($hb{"format$n"}eq"html"){if($stag=~m|format="\w+"|){$stag=~s|format="\w+"|format="html"|i}
else{$stag=~s|\s*-->| format="html" -->|i}}else{$val=~s!\r\n|\r|\n!<br>\n!gs;if($stag=~m|format="\w+"|){$stag=~s|format="\w+"|format="text"|i}}
if(defined $hb{"image_select$n"}){$val=&to($stag,$tcontent,$hb{"image_select$n"})}elsif(defined $hb{"file_select$n"}){$val=&tn($stag,$tcontent,$hb{"file_select$n"},$hb{"link_text$n"})}$stag.$val.$etag/gsie;
$gen='<meta name="generator" content="Page Publisher,http://www.interactivetools.com">';if($hc{'branding'}){if($html!~/$gen/is){
unless($html=~s/(<meta[^>]+>)/$gen\n$1/is){$html=~s/(<head[^>]*>)/$1\n$gen\n/i}}$time=&sj("Jan 1st,2000 HH:MM:SS",time);
$lastup="<!-- Last Updated $time with Page Publisher by interactivetools.com -->";unless($html=~s/<!-- Last Updated.*?interactivetools\.com -->/$lastup/is){
$html="$lastup\n\n$html"}}else{$html=~s/$gen//is;$html=~s/<!-- Last Updated.*?interactivetools\.com -->//is}open(F,">$ha{'path'}");
print F$html;close(F);if(!$hc{'confirm_saved'}){&uo}print"Content-type: text/html\n\n" unless($ContentType++);print&sm("updated",\%ha);
exit}sub ul{&ta("_page_menus.html");my($num)=int$hb{"edithtml"};&sf(\%hh,\%he,$num)||die("page_edithtml : Can't find record # $num\n");
unless($hd{'cuser_admin'}||$he{'allow_all_users'}){my$current_user=$hd{'unum'};my$allowed_users=$he{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);
&sl("Access denied.") unless $hj{$current_user}}if(!-f $he{'path'}){$ha{'msg'}="Couldn't find '$he{'name'}' page.The following<br>file could not be found on the server:<br>$he{'path'}"}
elsif(!-r $he{'path'}){$ha{'msg'}="Couldn't read '$he{'name'}' page.Please ask your server<br>adminstrator to make the following file readable:<br>$he{'path'}"}
elsif(!-w $he{'path'}){$ha{'msg'}="Couldn't write '$he{'name'}' page.Please ask your server<br>adminstrator to make the following file writable:<br>$he{'path'}"}
if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}if($he{'updated'}){
$he{'updated'}=&sj('Sep 30th,2000 - HH:MM:SS',$he{'updated'})}else{$he{'updated'}="Never"}open(F,"<$he{'path'}");while(<F>){
$he{'html'}.=$_}close(F);$he{'html'}=~s/&/&amp;/gs;$he{'html'}=~s/</&lt;/gs;$he{'html'}=~s/>/&gt;/gs;print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("edithtml",\%he);exit}sub uq{&ta("_page_menus.html");my($num)=int$hb{'num'};if($num){&sf(\%hh,\%ha,$num);unless($hd{'cuser_admin'}||$ha{'allow_all_users'}){
my$current_user=$hd{'unum'};my$allowed_users=$ha{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);&sl("Access denied.") unless $hj{
$current_user}}$ha{'updated'}=time();&sh(\%hh,\%ha,$num)}open(F,">$ha{'path'}");print F$hb{'html'};close(F);if(!$hc{'confirm_saved'}){&uo($table)}
print"Content-type: text/html\n\n" unless($ContentType++);print&sm("updated",\%ha);exit}sub tw{print"Content-type: text/html\n\n" unless($ContentType++);
$field_name=$hb{'field_name'}||die("browse: you must pass a name/value for the 'field_name'!\n");$ha{'field_name'}=$hb{'field_name'};
my$template_filename;if($hb{'browse_dir'}){$template_filename='_browse_dir.html'}else{$template_filename='_browse_file.html'}
&ta($template_filename,\%ha);$sep='/';if($hb{'mkdir'}){$ha{'mkdir'}=$hb{'mkdir'};if(!length($hb{'mkdir_name'})){$hl{'dir_error'}='No directory name specified!'}
elsif($hb{'mkdir_name'}=~m/[^\w\-]/i){$hl{'dir_error'}='Directory name may only contain A-Z,a-z,0-9,- or _'}elsif(-d "$hb{'cdir'}$sep$hb{'mkdir_name'}"){
$hl{'dir_error'}='Directory already exists!'}elsif(!mkdir("$hb{'cdir'}$sep$hb{'mkdir_name'}",0777)){$hl{'dir_error'}='Unable to create dir : '.$!}
if($hl{'dir_error'}){$ha{'list'}=&tb('dir_error',\%hl)}}if($hb{'mkfile'}){my$fh=do{local *F; *F};$ha{'mkfile'}=$hb{'mkfile'};
if(!length($hb{'mkfile_name'})){$hl{'file_error'}='No file name specified!'}elsif($hb{'mkfile_name'}=~m/[^\w\-\.]/i){$hl{'file_error'}='File name may only contain A-Z,a-z,0-9,-,_ or.'}
elsif(-e "$hb{'cdir'}$sep$hb{'mkfile_name'}"){$hl{'file_error'}='File already exists!'}elsif(!open($fh,">$hb{'cdir'}$sep$hb{'mkfile_name'}")){
$hl{'file_error'}='Unable to create file : '.$!}close($fh);if($hl{'file_error'}){$ha{'list'}.=&tb('file_error',\%hl)}}$ha{'dir'}=$hb{'dir'}||$cgidir;
$ha{'dir'}=~s/^(.+)(\\|\/)+$/$1/;$ha{'dir2'}=$ha{'dir'};$ha{'dir2'}=~s!^([a-z]:)!$1/..!i;$ha{'parent'}=($ha{'dir'}=~m#^(.*)[\\/]#,$1||$sep);
$ha{'parent_ue'}=&td($ha{'parent'});$ha{'list'}.=&tb('parent',\%ha);if(!-e $ha{'dir'}){$error="Directory doesn't exist!"}
elsif(!-r $ha{'dir'}){$error="Directory isn't readable!"}if($error){$ha{'list'}.=&tb('error');print&ta($template_filename,\%ha);
exit}opendir(DIR,"$ha{'dir2'}");@ao=sort{lc$a cmp lc$b} grep(!/^\.+$/,readdir(DIR));closedir(DIR);foreach$name(@ao){if(!-d "$ha{'dir'}$sep$name"){
next}$filepath="$ha{'dir'}$sep$name";$filepath=~s/$sep+/$sep/g;$filepath_ue=&td($filepath);($size,$mtime)=(stat($filepath))[7,9];
next if$mtime eq"";$modified=&sj("Jan 1st,2000 - HH:MM:SS",$mtime);$ha{'list'}.=&tb('dir');$files++}foreach$name(@ao){if(-d "$ha{'dir'}$sep$name"){
next}$filepath="$ha{'dir'}$sep$name";($size,$mtime)=(stat($filepath))[7,9];next if$mtime eq"";$size=(int($size/1000)||1)."KB";
$modified=&sj("Jan 1st,2000 - HH:MM:SS",$mtime);$filepath=~s/'/\\'/g;if(-f "$ha{'dir'}$sep$name"){$ha{'list'}.=&tb('file')}
else{$ha{'list'}.=&tb('other')}$files++}if(!$files){$ha{'list'}.=&tb('nofiles')}print&ta($template_filename,\%ha);exit}sub sx{&ta("_setup_menus.html");
&sf(\%ho,\%hc,1);$hc{'license_id'}='****************'if$hc{'demo'};foreach(sort keys %hc){if(!/\W/&&$hc{$_}!~/\W/){$hc{"$_"."_$hc{
$_}_checked"}="checked";$hc{"$_"."_$hc{$_}_selected"}="selected"}}$login_timeout_min||=60;print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("edit",\%hc);exit}sub sy{&ta("_setup_menus.html");if(!$hb{'admin_id'}||!$hb{'admin_pw'}){print"Content-type: text/html\n\n" unless($ContentType++);
$ha{'msg'}="You must enter a username and password for the admin user.";print&tb("showmsg",\%ha);exit}$hb{'login_timeout_min'}=int($hb{'login_timeout_min'})||60;
if($hb{'logoff_action'}==2&&!$hb{'logoff_url'}){$hb{'logoff_url'}="http://www.interactivetools.com/"}$hb{'helpurl'}||='http://www.interactivetools.com/docs/pagepublisher/';
foreach(qw(license_name license_domain d c f ver product)){$hb{$_}=$hc{$_}}if(!&uy($hb{'license_id'})){$hb{'license_id'}=$hc{'license_id'};
$invalid_license_id++} elsif($hb{'license_id'}ne$hc{'license_id'}){$license_id_changed++}if($hb{'client_upload'}){if(defined($hb{'upload_dir'})&&length($hb{'upload_dir'})){
$hb{'upload_dir'}=~s|([^/])$|$1/|;unless(-e $hb{'upload_dir'}){$error='Upload directory does not exist!<br>'}}else{$error='Upload directory may not be left blank!<br>'}$hc{'upload_dir'}=$hb{'upload_dir'};
if(defined($hb{'upload_url'})&&length($hb{'upload_url'})){$hb{'upload_url'}=~s|([^/])$|$1/|}if($hb{'upload_url'}!~m|^https?://|i){
$error.='Upload URL must begin with "http://" or "https://"<br>'}$hc{'upload_url'}=$hb{'upload_url'}}if($error){$ha{'msg'}=$error;
print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}&sh(\%ho,\%hb,1);if($hb{'titlebar'}){
$hd{'ui_titlebar'}=$hb{'titlebar'}}if($hb{'footerbar'}){$hd{'ui_footerbar'}=$hb{'footerbar'}}$hd{'tbcolor'}="$hb{'tbcolor1'}$hb{'tbcolor2'}$hb{'tbcolor3'}";
$hd{'bgcolor'}="$hb{'bgcolor1'}$hb{'bgcolor2'}$hb{'bgcolor3'}";$hd{'imageurl'}=$hb{'imageurl'};$hd{'helpurl'}=$hb{'helpurl'};
$hd{'cuser_id'}=$hb{'admin_id'};$hd{'license_num'}=&ug($hc{'license_id'});$hc{'confirm_saved'}=$hb{'confirm_saved'};&sw("id",$hb{'admin_id'});
&sw("pw",$hb{'admin_pw'});if($invalid_license_id){$hd{'error'}='<p align=center><font face="arial,sans-serif" style="font-size: 12px;"><b><font color="#FF0000">Invalid Product ID!<br></font></b></font></p>';
&sx()}if($license_id_changed){$hc{'license_id'}=$hb{'license_id'};&tq()}if(!$hc{'confirm_saved'}){&sx}print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("saved",\%ha);exit}sub sn{if(!&uy($hc{&sp("bGljZW5zZV9pZA==")})){exit}my$valid_login=0;my$unum;&ta("_interface.html");
if($ENV{'HTTP_USER_AGENT'}=~/Mozilla\/(\d)/&&$1<4){&sz('oldbrowser')}if($hb{'login'}&&!$hq{'cookies'}){&sz('nocookies')}
if($hb{'login'}){$id=lc$hb{'id'}}else{$id=lc$hq{'id'}}if($hb{'login'}){$pw=lc$hb{'pw'}}else{$pw=lc$hq{'pw'}}my($aid,$apw)=(lc$hc{'admin_id'},lc$hc{'admin_pw'});
if($hb{'login'}&&(!defined $hb{'id'}||!defined $hb{'pw'})){$valid_login=0}elsif(defined $hb{'id'}&&$hb{'id'}eq""){$ha{'error'}="Enter username"}
elsif(defined $hb{'pw'}&&$hb{'pw'}eq""){$ha{'error'}="Enter password"}elsif($id&&$aid eq$id&&$apw eq$pw){$valid_login=1;
$hd{'cuser_admin'}=1}unless($hd{'cuser_admin'}){my($day,$mon,$year)=(localtime(time))[3,4,5];$mon++; $year+=1900;my%hk;my$test=sub{
if(($id eq lc($hk{'login_id'}))&&($pw eq lc($hk{'login_pw'}))){$valid_login=1;if($hk{'disabled'}){$ha{'error'}='Account disabled'}$hd{'unum'}=$hk{'num'};
unless($hk{'expires_never'}){if($hk{'expires_year'}<$year){$ha{'error'}="Account Expired"} elsif(($hk{'expires_year'}==$year)&&($hk{'expires_mon'}<$mon)){
$ha{'error'}="Account Expired"} elsif(($hk{'expires_year'}==$year)&&($hk{'expires_mon'}==$mon)&&($hk{'expires_day'}<$day)){
$ha{'error'}="Account Expired"}}}};&sd(\%hn,\%hk,undef,$test)}if(!$valid_login&&!$ha{'error'}&&($ENV{'CONTENT_LENGTH'}||$ENV{'QUERY_STRING'})){
$ha{'error'}="Invalid username and/or password"}if(!$valid_login||$ha{'error'}){$ha{'id'}=&sk($id);$ha{'pw'}=&sk($pw);&sw('cookies','yes');
print"Content-type: text/html\n\n" unless($ContentType++);print&tb("login",\%ha);&ux;exit}&sw('id',$id);&sw('pw',$pw);$hd{'cuser_id'}=$id}
sub sz{$errcode=shift;$data1=shift;&ta("_interface.html");if($errcode eq"nojs"){$msg=&tb('nojavascript')}elsif($errcode eq"nocookies"){
$msg=&tb('nocookies')}elsif($errcode eq"oldbrowser"){$msg=&tb('oldbrowser')}elsif($errcode eq"dirnotwritable"){$dir=$data1;
$msg=&tb('dirnotwritable')}elsif($errcode eq"filenotwritable"){$file=$data1;$msg=&tb('filenotwritable')}elsif($errcode eq"persistentfilelock"){
$dir="$data1/";$msg=&tb('persistentfilelock')}elsif($errcode eq"serverbusy"){$msg=&tb('serverbusy')}elsif($errcode eq"about"){
$msg=&tb('about',\%hc)}elsif($errcode eq"expired"){$msg=&tb('expired',\%hc)}elsif($errcode eq"no_data_dir"){$msg=&tb('no_data_dir')}
elsif($errcode eq"data_dir_not_writable"){$msg=&tb('data_dir_not_writable')}elsif($errcode eq&sp("Y29ycnVwdGVk")){$msg=&tb(&sp("Y29ycnVwdGVk"))}
elsif($errcode eq"demo_no_browse_redir"){$msg=&tb('demo_no_browse_redir')}elsif($errcode eq"demo_no_browse"){$msg=&tb('demo_no_browse')}
elsif($errcode eq"demo_no_setup_save"){$msg=&tb('demo_no_setup_save')}elsif($errcode eq"demo_no_page_add"){$msg=&tb('demo_no_page_add')}
else{$msg="Unknown error code : $errcode\n"}print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg");
&ux();exit}sub so{&ta("_interface.html");&sw('id',"");&sw('pw',"");if($hc{'logoff_action'}==1){print"Content-type: text/html\n\n" unless($ContentType++);
print&tb("login",\%ha);&ux();exit}else{$hc{'logoff_url'}||="http://www.interactivetools.com/";print"Content-type: text/html\n\n" unless($ContentType++);
print qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"><html><head><meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"><meta http-equiv="REFRESH" content="0; URL=$hc{'logoff_url'}"></head><body></html>\n|;
exit}}sub sm{local($cell)=$_[0];local($out)=$_[1];unless($cell){die("Interface : No template cell was specified!\n")}if(ref($_[1])ne"HASH"){
die"Interface : The second argument must be a HASH reference!\n"}unless($ContentType++){print"Cache-Control: no-cache\n";
print"Pragma: no-cache\n";print"Expires: Sun,10 Feb 2002 16:00:00 GMT\n";print"Content-type: text/html\n\n"}if($hd{'cuser_admin'}){
$ha{'menubar_admin'}=&tb("menubar_admin")}$ha{'content'}=&tb($cell,$out);print&tb("interface",\%ha);&ux();exit}sub uk{if(!$hc{'confirm_erase'}){&un}
&ta("_page_menus.html");my($num)=int$hb{"page_confirm_erase"};&sf(\%{"hh"},\%ha,$num)||die("page_confirm_erase : Can't find record # $num\n");
unless($hd{'cuser_admin'}||$ha{'allow_all_users'}){my$current_user=$hd{'unum'};my$allowed_users=$ha{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);
&sl("Access denied.") unless $hj{$current_user}}print"Content-type: text/html\n\n" unless($ContentType++);print&sm("confirm_erase",\%ha);
exit}sub un{&ta("_page_menus.html");my($num)=$hb{'num'}||$hb{"page_confirm_erase"};my%hp;&sf(\%hh,\%hp,$num);unless($hd{'cuser_admin'}||$hp{'allow_all_users'}){
my$current_user=$hd{'unum'};my$allowed_users=$hp{'users'};my%hj=map{$_,1} split(/,/,$allowed_users);&sl("Access denied.") unless $hj{
$current_user}}&sc(\%{"hh"},$num)||die("page_erase : Can't find record # $num\n");if(!$hc{'confirm_erased'}){&uo}print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("erased",\%ha);exit}sub up{&ta("_page_menus.html");if(!$hb{'name'}){$ha{'msg'}="You must specify a page name"}elsif(!$hb{'path'}){
$ha{'msg'}="You must specify a filepath"}elsif(!$hb{'url'}||$hb{'url'}eq"http://"){$ha{'msg'}="You must specify a page URL"}
if($ha{'msg'}){print"Content-type: text/html\n\n" unless($ContentType++);print&tb("showmsg",\%ha);exit}unless($hd{'cuser_admin'}){
$hb{'allow_all_users'}=0;$hb{'users'}=$hd{'unum'}.','}&sa(\%{"hh"},\%hb,$num);%ha=%hb;if(!$hc{'confirm_saved'}){&uo}print"Content-type: text/html\n\n" unless($ContentType++);
print&sm("added",\%ha);exit}sub uj{&ta("_page_menus.html");($day,$mon,$year)=(localtime(time))[3,4,5];$mon++; $year+=1900;
$he{"day_$day"."_selected"}="selected";$he{"mon_$mon"."_selected"}="selected";$he{"year_$year"."_selected"}="selected";if($hd{'cuser_admin'}){
my$user_menu=&tm($ha{'users'});my%hz=('user_menu'=>$user_menu,'allow_all_users_checked_1'=>' checked');$he{'users'}=&tb('user_menu',\%hz)}
print"Content-type: text/html\n\n" unless($ContentType++);print&sm("add",\%he);exit}sub sl{print"Content-type: text/html\n\n" unless($ContentType++);
$ha{'msg'}="<b>Error :&nbsp;</b>";foreach(@_){$ha{'msg'}.=&sk("$_ ")}if(-e "$hd{'datadir'}/$hd{'filelock'}"){rmdir("$hd{'datadir'}/$hd{'filelock'}")}
&ta("_interface.html");print&tb("showmsg",\%ha);exit}sub sv{foreach$db(keys %::){if(!defined ${$db}{'datafile'}){next}my($path)="${
$db}{'datafile'}";$path=~s/\\/\//g;if($path=~/^(.*?)[^\/]+$/){if(!-w $1){&sz('dirnotwritable',$1)}}if(-e $path&&!-w $path){&sz('filenotwritable',$path)}}
my(%hc);&sf(\%ho,\%hc,1);if($hc{'titlebar'}){$hd{'ui_titlebar'}=$hc{'titlebar'}}if($hc{'footerbar'}){$hd{'ui_footerbar'}=$hc{'footerbar'}}$hd{'tbcolor'}="$hc{'tbcolor1'}$hc{'tbcolor2'}$hc{'tbcolor3'}";
$hd{'bgcolor'}="$hc{'bgcolor1'}$hc{'bgcolor2'}$hc{'bgcolor3'}";$hd{'imageurl'}=$hc{'imageurl'};$hd{'helpurl'}=$hc{'helpurl'};
if($hc{'login_timeout'}){$hd{'login_timeout_sec'}=($hc{'login_timeout_min'}*60)||(60*60)}else{$hd{'login_timeout_sec'}=(60*60*10)}
my($file,$data)=$0;$file=~s/.*[\/\\]//;$f=&f($file);my$mime_str=&sp("Y29ycnVwdGVk");("4:4443855555555555555555555555555","6066672")- $f&&&sz($mime_str);
return%hc}sub su{my($max)=$_[0];my($name,$value,$pair,@ai,$buffer,%hg);my($file,$path,$ext);my($boundary);binmode(STDIN);
if($max&&($ENV{'CONTENT_LENGTH'}||length $ENV{'QUERY_STRING'})>$max){die("ReadForm : Input exceeds max input limit of $max bytes\n")}($boundary)=$ENV{'CONTENT_TYPE'}=~/boundary=(?:"?)(\S+?)(?:"?)$/;
if($ENV{'REQUEST_METHOD'}eq"POST"&&$ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|){while(<STDIN>){if(/^--$boundary--/){$buffer.="--$boundary"; last}
else{$buffer.=$_}}@ai=split(/--$boundary/,$buffer);foreach$pair(@ai){unless($pair=~/^(\r\n|\n)Content-Disposition/){next}($name,$value)=$pair=~/^(?:\r\n|\n)(.*?)(?:\r\n|\n){2}(.*?)(?:\r\n|\n)$/s;
($path)=$name=~/filename="([^"]+)"/;($name)=$name=~/name="([^"]+)"/;($file)=$path=~/([^\/\\]+)$/;($ext)=$path=~/([^\.]+)$/;
if(!$path){$name=~s/\r\n/\n/g;$value=~s/\r\n/\n/g;$name=~s/\x00//g;$value=~s/\x00//g}$hg{"$name"}=$value;$hg{"$name"."_path"}=$path;
$hg{"$name"."_file"}=$file;$hg{"$name"."_ext"}=$ext}}else{if($ENV{'REQUEST_METHOD'}eq'POST'){read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'})}
elsif($ENV{'REQUEST_METHOD'}eq'GET'){$buffer=$ENV{'QUERY_STRING'}}@ai=split(/&/,$buffer);foreach$pair(@ai){($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;$value=~s/%([A-F0-9]{2})/pack("C",hex($1))/egi;$value=~s/\r\n/\n/go;if($name eq'users'){$hg{$name}.=$value}
else{$hg{$name}=$value}}}foreach(keys %hg){if(/^(.*)(\.x|\.y)$/){$hg{$1}="true"}}return%hg}sub sw{my($cookie_info);my($name,$value,$exp,$path,$domain,$secure)=@_;
my($expires);unless(defined $name){die("SetCookie : Cookie name must be specified\n")}if($exp&&$exp ne int($exp)){die("SetCookie : Expire Date isn't in seconds using time();\n")}
if($exp){$expires=&sj("Mon,01-Jan-1999 HH:MM:SS GMT",$exp,'GMT')}if($name){$name=&td($name)}if($value){$value=&td($value)}
if($exp){$cookie_info.="expires=$expires; "}if($path){$cookie_info.="path=$path; "}if($domain){$cookie_info.="domain=$domain; "}
if($secure){$cookie_info.="secure; "}print"Set-Cookie: $name=$value; $cookie_info\n"}sub st{my($cookie,$name,$value,%hw);
foreach$cookie(split(/; /,$ENV{'HTTP_COOKIE'})){($name,$value)=split(/=/,$cookie);foreach($name,$value){$_=&tc($_)}$hw{$name}=$value}
return%hw}sub td{my($text)=$_[0];$text=~tr/ /+/;$text=~s/([^A-Za-z0-9\+\*\.\@\_\-])/uc sprintf("%%%02x",ord($1))/egx;return$text}
sub tc{my($text)=$_[0];$text=~tr/+/ /;$text=~s/%([A-F0-9]{2})/pack("C",hex($1))/egi;return$text}sub ta{if(!$_[0]){die"Template : No template file was specified!\n"}
if(!-e "$hd{'cgidir'}/templates/$_[0]"){die"Template : Template file '$hd{'cgidir'}/$_[0]' does not exist!\n"}if($_[1]&&ref($_[1])ne"HASH"){
die"Template : The second argument must be a HASH reference or undefined!\n"}my($file)="$hd{'cgidir'}/templates/$_[0]";my($hashref)=$_[1];
my(%hg)=%{$hashref};my($content);local(*F);if($hashref){foreach(keys %hd){$hg{$_}=$hd{$_}}}else{foreach(keys %hd){${$_}=$hd{
$_}}}open(F,"<$file")||die"Template : Couldn't open $file! $!\n";while(<F>){$content.=$_}close(F);my@au=($content=~m/<!-- templatecell\s?:\s?([A-Za-z0-9_\.]+) -->/g);
foreach$cell(@au){if($content=~m/<!-- templatecell\s?:\s?($cell) -->(?:\r\n|\n)?(.*?)<!-- \/templatecell\s?:\s? \1 -->/is){
$ih{$1}=$2}}$content=~s/<!-- templatecell\s?:\s?([A-Za-z0-9_\.]+) -->(?:\r\n|\n)?(.*?)<!-- \/templatecell\s?:\s? \1 -->//gs;
for($content){s/<!-- template insert\s?:\s?(.*?) -->/\1/gi;if($hashref){s/\$(\w+)\$/$hg{$1}/g}else{s/\$(\w+)\$/${$1}/g}}
return$content}sub tb{if(!$_[0]){die"Template : No template cell was specified!\n"}if(!defined $ih{$_[0]}){die"Template : Template cell '$_[0]' is not defined!\n"}
if($_[1]&&ref($_[1])ne"HASH"){die"Template : The second argument must be a HASH reference or undefined!\n"}my($cellname)=$_[0];
my($hashref)=$_[1];my(%hg)=%{$hashref};my($content)=$ih{$cellname};local(*F);$content=~s/<!-- templatecell\s?:\s?([A-Za-z0-9_\.]+) -->(?:\r\n|\n)?(.*?)<!-- \/templatecell\s?:\s? \1 -->//gs;
for($content){s/<!-- template insert\s?:\s?(.*?) -->/\1/gi}if($hashref){foreach(keys %hd){$hg{$_}=$hd{$_}}}else{foreach(keys %hd){
${$_}=$hd{$_}}}if($hashref){$content=~s/\$(\w+)\$/$hg{$1}/g}else{$content=~s/\$(\w+)\$/${$1}/g}return$content}sub ug{$PP_charset="0123456789ABCDEFGHJKMNPQRSTUVWXYZ";
for(0..32){my$n=$_;my$c=substr($PP_charset,$n,1);$ik{$c}=$n;$av[$n]=$c}my$lkey=shift||die("No license key specified!");my$bnum=47;
$lkey=uc $lkey;$lkey=~tr/ //d;my$decode_quad=sub{my($num);for(0..3){$num+=$ik{(reverse split(//,$_[0]))[$_]}*33**$_}return$num};
my($q1,$q2,$q3,$q4,$q5)=split(/-/,$lkey);my$pid=&$decode_quad($q1);my$lnum=$pid / $bnum;$hd{'header_product_id'}=$pid;if($lnum ne int($lnum)){
die("Error: lnum isn't an int!")}return$lnum}sub tl{my$TEST=shift;if($TEST&&ref($TEST)ne'HASH'){die("_cgidir: First argument must be undefined or a hash reference!\n")}
my$PROGRAM_NAME=$TEST ? $TEST->{'$0'} : $0;my$SCRIPT_FILENAME=$TEST ? $TEST->{'SCRIPT_FILENAME'} : $ENV{'SCRIPT_FILENAME'};
my$cgifile=$PROGRAM_NAME;$cgifile=~s/.*[\\\/]//;my$cgidir;if($PROGRAM_NAME=~m/$cgifile$/i&&$PROGRAM_NAME=~s/^(.*)[\\\/].*/$1/){
$cgidir=$PROGRAM_NAME}elsif($SCRIPT_FILENAME=~m/$cgifile$/i&&$SCRIPT_FILENAME=~s/^(.*)[\\\/].*/$1/){$cgidir=$SCRIPT_FILENAME}
else{if($TEST){$cgidir=$TEST->{'_cd'}||$TEST->{'_pwd'}}else{$cgidir=($^O=~/mswin/i) ? `cd` : `pwd`}$cgidir=~s/\s+$//g}$cgidir=~s|\\|/|g;
return($cgidir,$cgifile)}sub tx{my($source,$dest)=@_;local(*SOURCE);local(*DEST);open(SOURCE,"<$source")||return0;open(DEST,">$dest")||return0;
binmode(SOURCE);binmode(DEST);print DEST<SOURCE>;close(SOURCE);close(DEST);return1}sub ts{unless(-e "$hd{'datadir'}/setup.dat.cgi"){
unless(-e "$hd{'datadir'}"){&sz('no_data_dir')}unless(-w $hd{'datadir'}){&sz('data_dir_not_writable')}&sg("$hd{'cgidir'}/$hd{'filelock'}");
unless(&tx("$hd{'cgidir'}/page.dat","$hd{'datadir'}/page.dat")){&si("$hd{'cgidir'}/$hd{'filelock'}");&sz('data_dir_not_writable')}
open(OLD_SETUP,"$hd{'cgidir'}/setup.dat.cgi");while($data_line!~/^\d/){chomp($data_line=<OLD_SETUP>)}close(OLD_SETUP);my@ap=split(/¡/,$data_line);
foreach(@ap){s/¿([A-F0-9]{2})/pack("C",hex($1))/egix}my@at=qw(num titlebar tbcolor1 tbcolor2 tbcolor3 bgcolor1 bgcolor2 bgcolor3 imageurl client_id client_pw admin_id admin_pw login_timeout login_timeout_min logoff_action logoff_url client_add client_edithtml client_remove confirm_erase confirm_erased confirm_saved license_name license_domain license_id d c f);
my%hv=map{$_,shift @ap} @at;$hv{'product'}='pp';$hv{'ver'}=1.18;$hv{'helpurl'}='http://www.interactivetools.com/docs/pagepublisher/';
&sh(\%ho,\%hv,1);unlink("$hd{'cgidir'}/page.dat");unlink("$hd{'cgidir'}/setup.dat.cgi");&si("$hd{'cgidir'}/$hd{'filelock'}");%hc=&sv();
&tq()}}sub tr{my$old_version=shift||1.0;if($old_version<1.19){if(!$hc{'titlebar'}){$hc{'titlebar'}='Page Publisher'}$hc{'footerbar'}='Copyright (C) 2003 interactivetools.com,inc.';
$hc{'product'}='pp';$hc{'branding'}=1}if($old_version<1.20){unless(-e "$hd{'datadir'}/user.dat.cgi"){&sl("User data file not found.")}
unless(-w "$hd{'datadir'}/user.dat.cgi"){&sl("User data file is not world writable.")}if($hc{'client_id'}ne""){my($day,$mon,$year)=(localtime)[3,4,5];
$mon++;my$currentyear=$year+1900;my$nextyear=$currentyear+1;my@am=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);my$expiry_date="$day $am[$mon - 1] $nextyear";
my%ij=('name'=>'First User','login_id'=>$hc{'client_id'},'login_pw'=>$hc{'client_pw'},'created_mon'=>$mon,'created_day'=>$day,'created_year'=>$currentyear,'expires_mon'=>$mon,'expires_day'=>$day,'expires_year'=>$nextyear,'expires_date'=>$expiry_date,'expires_never'=>1);
my$unum=&sa(\%hn,\%ij);my%hp;$record_code=sub{$hp{'users'}=$unum.',';$hp{'allow_all_users'}=0;&sh(\%hh,\%hp,$hp{'num'})};
&sd(\%hh,\%hp,undef,$record_code)}$hc{'perpage'}=10}if($old_version<1.22){my%ie=('client_upload'=>0,'upload_max'=>1,'upload_max_filesize'=>200,'image_max'=>1,'image_max_width'=>250,'image_max_height'=>200,'upload_allowed_extensions'=>'gif,jpg,jpeg');
foreach$key(keys %ie){$hc{$key}=$ie{$key}}}$hc{'ver'}=$hd{'ver'};&sh(\%ho,\%hc,1)}sub ux{print'<!--'."\n";print$hd{'ui_titlebar'}.' v'.$hd{'ver'}.' (Build: '.$hd{'prod_id'}.'.'.$hd{'header_product_id'}.")\n";
print'License #'.$hd{'header_license_num'}.' ~ '.$hd{'header_license_name'}.' ~ '.$hd{'header_license_domain'}."\n";printf('Execute time: %01d seconds'."\n",time() - $^T);
print'-->'."\n"}1;
# ----------------------------------------------------------------------------
#        Programming by interactivetools.com, inc. <info@interactivetools.com>