#!/usr/bin/perl ($stdinarg)=@ARGV; BEGIN { $| = 1; # print "Content-type: text/html\n\n"; } # ";} END { &ht_hd; print "
Program finished unpredicted.
\n"; } my ($i,@df)=split(/,/, $F{RePdB}); ### Get values from data in another dateb for(my $j=0; $j<$i; $j++) { my ($a,$b,$c,$d)=split(/\+/, $df[$j]); $F{$a}=&get_any_field($d,$F{$b},2*($c-1)); $F{RePdB}=$d; $F{RePpW}=$c; } my ($in,@fn)=split(/,/, $F{RePfN}); ### Get values from function calls for(my $j=0; $j<$in; $j++) { my ($a,$b,$c)=split(/\+/, $fn[$j]); &$c($a,$b); } for (my $j=1; $j<=$H{num_fields}; $j++) { if($I[j]{type} eq "TA") { my $z="n$j"; $F{$z}=~tr/\n/
/; } } if($F{a}ne""){ @fI=split(//,$F{a}); } if($F{at}ne""){ @Fi=split(//,$F{at}); } my $x=@Fi; if ($x eq 0){ $Fi[0]=0; } } # # Create IP address structures. # # The first argument must be 'tcp', or 'udp'. # The second argument is the host (`hostname` if null) to connect to. # The third argument is the port to bind to. Pass 0 if any will do. # # The return arguments are a protocol value that can use by socket() # and a port address that can be used by bind(). # sub get_IP_addr_struct { local($protocol,$host,$port) = @_; local($junk,$host_addr); if (! $port && ($host =~ s,([^/]+)/(.+),$1,)) { $port = $2; } $host = &hostname() if ! $host; ($junk,$junk,$junk,$junk,$host_addr) = gethostbyname($host); die "gethostbyname($host): $!" unless $host_addr; if ($port =~ /[^\d]/) { ($junk,$junk,$port) = getservbyname($port,$protocol); die "getservbyname($port,$protocol): $!" unless $port; } return pack($SOCKADDR_IP, $AF_INET, $port, $host_addr); } sub get_proto_number { local($protocol) = @_; local($junk,$proto); ($junk,$junk,$proto) = getprotobyname($protocol); die "getprotobyname($protocol): $!" unless $proto; return $proto; } sub hostname { if (! $hostname) { chop($hostname = `hostname`); if (! $hostname) { chop($hostname = `uname -n`); if (! $hostname) { die "cannot determine hostname"; } } } return $hostname; } # # An extra... # sub unpack_IP_addr_struct { local($addr) = @_; local($af,$port,$host) = unpack($SOCKADDR_IP,$addr); local(@IP) = unpack('C4',$host); return join('.',@IP)."/$port"; } sub GetInput { $hostm = $ENV{'REMOTE_HOST'}; $pathi= $ENV{'PATH_INFO'}; $input = $stdinarg; if ( $input eq "" ) { $input = $ENV{'QUERY_STRING'}; } if ( $input eq "" ) { read(STDIN, $input, $ENV{'CONTENT_LENGTH'}); } if ( $input eq "" ) { $input=$stdinarg; } if ( $input eq "" ) { open(FI, "; close(FI); } my $test=1; if($test){ open(DF,">/tmp/dm.html"); } foreach $pair (split(/&/, $input)) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $F{$name} = "$F{$name}"."$value"; if( $name ne "" ) { $forw.="&$name=$value"; } if($F{debug}){ print "\n\n \n\n"; printf "
%20.20s = %s
%20.20s = %s
\n", $name, $F{$name};}
}
$forw=~ tr/ /+/;
if($test){ printf DF "$forw\n"; close(DF); }
if (($F{password} eq "") and ($F{pD} ne "")){$F{password}=$F{pD}; }
if (($F{list} eq "") and ($F{l} ne "")){$F{list}=$F{l}; }
if (($F{list} eq "") and ($pathi ne "")){$F{list}=$pathi; }
if (($F{work} eq "") and ($F{w} ne "")){$F{work}=$F{w}; }
#if ( $F{list} eq "" ) { die "No database name given.\n"; }
if($F{work} ne "") { $H{head}=""; }
if($F{w} ne "") { $H{head}=""; }
}
sub encode_password{ $F{code_pw}="";
if ( "$F{password}" ne "" ) {
$F{code_pw}=&code_p($F{password});
# print "\n\n";
$F{password}=&uncode_p($F{password}); }
if($F{code_pw} ne ""){ $eP="&pD=$F{code_pw}"; } else { $eP=""; }
if($F{iP} ne ""){ $eP .="&iP=$F{iP}"; }
if($F{HD} ne ""){ $eP.="&HD=$F{HD}"; }
# print "\n\n";
$hP="\n";
}
sub code_p{ my($p)=@_;
if( $p =~ /^7Y.*Z4p$/ ) { return $p; }
$p=~ tr [!:,@_0-9A-Za-z] [a-lA-Pm-z0-5!:,@_U-Z6-9Q-T] ;
return "7Y$p" . "Z4p"; }
sub uncode_p{ my($p)=@_;
if( $p =~ /^7Y.*Z4p$/ ) { $p=~ s/^7Y//; $p=~ s/Z4p//;
$p=~ tr [a-lA-Pm-z0-5!:,@_U-Z6-9Q-T] [!:,@_0-9A-Za-z]; return $p; }
else { return $p; }
}
sub ht_hd{ my ($t)=@_;
if ($html_text_head eq "") { $html_text_head="y";
if($t eq "") { print "Content-type: text/html\n\n
Updated. check.
If not working, then back"; }
else {
print "Bugs in the new file.
Old file used okay "; system("cd /var/www/cgi-bin/; cp d~ d; cp d $nf "); } $nupd=`diff $nf /var/www/cgi-bin/d|head -4`; if ( "$nupd" ne "") { open(FM, "|/usr/lib/sendmail szhang\@udel.edu"); print FM "\n\n system not updated. \n"; close(FM); } &Finish; } sub setBack{ my $wb="cauchy.math.udel.edu"; my $lk="/cgi/dm?w=$F{w}"; my $fl="$dbhm/$F{list}/W$id.htm"; $nf="/home/szhang/host/d"; $nf="/var/www/cgi-bin/d_out/d"; print "Use old files.
"; system("cd /var/www/cgi-bin/; cp d~ d; cp d $nf "); &Finish; } sub VIEW{ &listdata; } sub DNS{ &rootpw("$H{super_root}", "DNS Service", "do DNS services"); } sub init_sys{ ############################################################ my $hlk=""; if(( $hostm =~ /cauchy.math.ud/ ) or ( $hostm =~ /superprism.net/ )) { if( $hostm =~ /hy.math.ud/ ){ $cauchym="
Steps you should follow:
NS1.SUPERPRISM.NET $mips NS2.SUPERPRISM.NET 199.125.170.10
It is of no charge to park your domain name here, to have a forward email address, and to have a single webpage hosted here.
Description of the database
",
"list_type", "2", "
Type of database only 3: db, em, bb ", "confirm_em", "1", "Email confirming each change, input y, a(email root too) or blank.", "cF", "2", "use for controls ni=== (ni=no head in newfrom)", "menus", "20", "Menu files and replacing functions, more of the following.", "headinclude", "15", "A head file name with complete path. if file-name=incl, it is put at the top. /sz/f.htm+2+/- Webp/- New/+/a/b/:/sz/f2" ); $HeadNum=0; for ($i=0; $i<50; $i++) { if ($x[3*$i] ne "") { $HeadName[$HeadNum]=$x[3*$i]; $HeadSize[$HeadNum]=$x[3*$i+1]; $HeadNote[$HeadNum]=$x[3*$i+2]; $HeadNum++; } } @tdcl=("F0FFE0", "E0E0E0","F0F0FF", "F0F0F0", "F0FFF0", "E0E0E0", "F0FFE0", "E0E0E0","F0F0FF", "F0F0F0", "F0FFF0", "E0E0E0", "F0FFE0", "E0E0E0","F0F0FF", "F0F0F0", "F0FFF0", "E0E0E0", "F0FFE0", "E0E0E0","F0F0FF", "F0F0F0", "F0FFF0", "E0E0E0", "F0FFE0", "E0E0E0","F0F0FF", "F0F0F0", "F0FFF0", "E0E0E0" ); if($F{work} ne "") { $H{head}=""; } if($F{w} ne "") { $H{head}=""; } } sub init_vars{ my $tag=$H{targeted}; if($tag eq "") { $tag=" target=_top"; } $fmhd="
\n\n"; } &personal_password(0); &Finish; } } sub personal_password{ my ($t)=@_; if($H{pwTrans} eq "") {return; } my (@a)=split(/\//, $H{pwTrans}); print "For PCCP board, please use scott as password in the window edit data as owner window below.
\n"; } } sub printphoto{ if ($H{indexph} eq "") { return; } print "$v\n"; last TYPES;}; /mu/&&do{ my @mu=split(/$I[$i]{sepa}0/,$d); my $s=@mu; for(my $w=0; $w<$s; $w++) { my $ww=$w+1; my @mu2=split(/$I[$i]{sepa}1/,$mu[$w]); my $s2=@mu2; for(my $w2=0; $w2<$s2; $w2++) { my $x=$w2; while($x > $I[$i]{cycl}) { $x-=$I[$i]{cycl};} my $sp="spac$x"; my $ss=$I[$i]{$sp}; if( $ss =~ /x/ ) { print ""; } else{ print "$I[$i]{$x} $mu2[$w2]"; } } } last TYPES;}; my $t="", $ff=""; if($I[$i]{sums} ne ""){ $f=$d-$Ilast[$i]; $Ilast[$i]=$d; $Itotal[$i] += $d; if("$I[$i]{tota}" ne "") { $t="
\n"; } } ################# List textarea data ################## sub listmsta{ &GetOneData; my $ix=2*$F{tafd}-2; if(( $I[$F{tafd}]{type} eq "ta" ) or ( $I[$F{tafd}]{type} eq "Ta" ) or ( $I[$F{tafd}]{view_op} eq "al" ) ) { print "Detailed information:
$G[$ix]\n"; } } sub printtabhd { my ($pp)=@_; if($F{pretable} ne "") { if($pp == 3 ) {print "\n";} return; } if( $pp == 2 ) { print "
$I[$i]{name} | \n";} else { print "$I[$i]{name} | \n";} } } print "
---|
"; $ii++; }
else { open(FF, "<$f"); @jk= |
Login now.\">\n"; &selfedit; &Finish; } my $n=&get_user_id($F{uname}); $F{uid}=$n; &synchronizeD($n); if(($F{findpd} ne "") or ($F{subm} eq "Help" ) ){ my $p=&get_any_field($F{list},$n,2*$H{indexpw}-2); &send_mail("","", "Your password in $H{description}", "It is $p","",$n); print "
The password is emailed to your address listed. Please check email and login again.\n"; &Finish; } if(( $F{upd} eq "" ) and ($F{password} ne "")){ $F{upd}=$F{password}; } if( $F{upd} ne &get_any_field($F{list},$n,$H{indexpw}*2-2) ) { $usrerrmsg="Wrong password. Try again."; &Finish; } &logout_usr($F{list}, $n); $F{iP}=&login_usr($F{list}, $n, $F{uname}); print &printhead(0); &login_home; } sub logout{ ############ login a user ############ if ($F{iP} ne "" ) { &check_login; } &logout_usr($F{list}, $F{uid}); &printhead(0); my @ms=("Good bye!", "Have a good day!", "Come back again!", "Have fun!", "Let us care!", "Make the world smaller!"); my $d=`date +%s` % 6; print "
Logout at $time;
$ms[$d]
"; if ($H{login_run} ne "") {my $p=$H{login_run}; &$p; } } sub get_user_id{ my($un)=@_; my $n=&chk_usr($F{list},$un); if(($n eq "") or ( ! (-f "$dbhm/$F{list}/$n"))) { print "$fmhd $fmhid=w value=cfn-login> $fmhid=uname value=\"$un\"> $fmhid=upd value=\"$F{upd}\"> $fmsub=subm value=\"Click here to create a user $un \">
"; $usrerrmsg="No such a user: $un"; &Finish; } return $n; } sub send_mail{ my($f,$e, $s, $c, $n, $id)=@_; if (($e eq "")and($id ne "")) { $e=&get_any_field($F{list},$id,2*$H{indexem}-2); } ############# print "
Sorry! You cannot send yourself a
message.
This is to prevent someone do self-evaluation.
[Because only email receivers can evaluate email senders.]\n"; &Finish; }
my $n=&getid($H{mailbox});
system("echo z$F{Toid}Z >> $dbhm/$F{list}/e/$F{uid}");
@G=(); $G[0]=$time; $G[1]=$n; $G[2]=$F{uid};
$G[3]="$F{Toid},"; $G[4]=$F{subject}; $G[5]=$F{content}; $G[6]=$F{list};
$G[8]=$F{Rp}; &PutOneData($n, $H{mailbox});
print "Your message is sent to $F{ToUname} as # $n
Your $ms: "; if($bx eq "" ){ print " Empty "; } else{ print "
$G[5]
Login first if you wish to do evaluation.";}
else{ print "$fmhd $fmhid=w value=cfn-eV> $fmhid=h value=y>
The user's name you wish to evaluate (eg szhang):
$fminp=uN size=10>
\n";
if($F{uN} ne ""){ my $tid=&get_user_id($F{uN}), $a{b}=$tid;
my $st=`grep "z$F{uid}Z" $dbhm/$F{list}/e/$tid`;
if($st eq ""){ print "Sorry, $F{uN} never send message to you
before -- so you cannot evaluate $F{uN}."; &Finish; }
&append_one_field($F{list}, $tid, 14, "
",; close(FI);} sub cR{ if( $F{h} ne ""){&printhead(0);} &cRf; open(FI,"tac $dbhm/$F{list}/cR|head -46|"); print ; close(FI); } sub cRf{ if($F{iP} eq "") { print " You need to login if you wish to talk.";} else{ if($F{tM} ne ""){ open(FO, ">>$dbhm/$F{list}/cR"); print FO "$F{uname} [$daytime]: $F{tM}
\n"; close(FO); } print "$fmhd $fmhid=w value=cfn-cR> $fmhid=h value=y>Your talk message:
$fminp=tM size=80> \n"; } print "$fmhd $fmhid=w value=cfn-cR> $fmhid=h value=y> \n"; } sub bBf{ if($F{iP} eq "") { print "
Login first if you wish to post a msg.";} else{ if($F{tM} ne ""){ open(FO, ">>$dbhm/$F{list}/bB/h"); my $c=`tail -1 $dbhm/$F{list}/bB/c`; $c++; system("echo $c >> $dbhm/$F{list}/bB/c"); print FO "$F{uname} [$daytime]: $hlk&w=cfn-bB&h=y&mid=$c&iP=iP> $F{tM}
\n"; close(FO); open(FO, ">>$dbhm/$F{list}/bB/$c"); print FO "$F{uname} [$daytime]: $F{tM}\n$F{cT}\n"; close(FO); } print "$fmhd $fmhid=w value=cfn-bB> $fmhid=h value=y> Post a new message (by $F{uname}):
Subject(nonempty!)$fminp=tM size=60>
\n"; } if($F{mid} ne ""){ my $m=`cat $dbhm/$F{list}/bB/$F{mid}`; print "
Message #$F{mid}:
$m\n"; } } sub bB{ if( $F{h} ne ""){&printhead(0);} &bBf; print "
All posts:"; open(FI,"cat $dbhm/$F{list}/bB/h | sed 's/iP=iP/iP=$F{iP}/g' |"); print
; close(FI); } sub sF{ if( $F{h} ne ""){&printhead(0);} &check_login; if( $F{subm} eq ""){ my @x=split(/,/, $H{selectfd}); my @z=(); for my $y (@x) { my ($a,$n,$s)=split(' : ',$I[$y]{description}); @z=(@z, split(/,/, $s)); } print " Click each class to see the registrated students.
\n"; for my $i ( @z ) { $i=~ s/
//ig; my $l=$i; $l=&noleadspace($l); $l=~s / /+/g; print "- Class $hlk&w=cfn-sF&subm=$l&h=y&cca=$F{cca}&iP=$F{iP}> $i \n"; } &Finish; } print "
Class waiting list $F{subm}:
\n"; my ($n, @x)=split(/:/, $H{selectfds} ); for(my $j=0; $j<$n; $j++){ my ($f, @ss)=split(/,/, $x[$j] ); for my $s(@ss) { &select_onef($f, $s, $F{subm}); } } print "
\n"; } sub noleadspace{ my ($f)=@_; Do_Again: if(substr($f, 0, 1) eq " "){ $f=substr($f, 1, 1000); goto Do_Again; } return $f; } sub select_onef{ my ($f, $s, $w)=@_; # print "- $f, $s, $w\n"; $s=2*$s-2; $f=2*$f-2; my @fn=`cd $dbhm/$F{list}; grep -B 1 -e '^($s)' [0-9]* | \ grep -i '$w'`; if($fn[0] eq ""){ return; } for my $fi (@fn) { my $nm=`cd $dbhm/$F{list}; grep -B 1 -e '^($f)' [0-9]* |head -1`; print "
- $nm\n"; } } sub subdb{ &printhead(0); &check_login; my $w=$F{wk}; $F{n5}=$F{uid}; $F{list}.="/$F{db}"; &GetTableDef; if( $F{subm} ne "Input") { &newform("cfn-subdb","$fmhid=db value=$F{db}> $fmhid=noecho value=DONE>"); } else { &newdata; } } sub cSum{ if( $F{h} ne ""){&printhead(0);} &check_login; print "
Cost estimation from pre-registration:
"; &GetOneData($F{uid},$F{list}); my $s=30; print "
Total: \$ $s.\n"; print "- Parent duty deposit: \$ $s; (partial total: \$ $s)\n"; my @x=(14,17,20,23); my $cs=125; for my $y ( @x) { my $a=$G[2*$y-2]; if( $a ne "" ) { $s+=$cs; print "
- Chinese $a : \$ $cs; (partial total: \$ $s)\n"; if($cs > 115){ $cs=115; } } } @x=(15,18,21,24); $cs=50; if( $G[26*2-2] ne "" ) { $cs =0; } for $y ( @x) { my $a=$G[2*$y-2]; my @b=split(/
- /, $a); for $c ( @b ) { if ($c ne ""){ $s+=$cs; print "
- $c : \$ $cs; (partial total: \$ $s)\n"; } } } print "
Bill sent from the School:
"; } sub pF{ if( $F{h} ne ""){&printhead(0);} &check_login; print "
Change data:
"; if (($F{noi} eq "" )and($F{nnoi} eq "" )) { $I[1]{noinput}="noi"; $I[5]{noinput}="noi"; } else { my @n=split(/,/,$F{noi}); for my $i (@n){ $I[$i]{noinput}="noi"; } my @n=split(/,/,$F{nnoi}); for my $i (@n){ $I[$i]{noinput}=""; } } $F{id}=$F{uid}; $F{password}=&uncode_p($F{upD}); $hP="$fmhid=pD value=$F{upD}>$fmhid=noecho value=Done>"; &selfedit; } sub dM{ my ($f, $m)=@_; &GetOneData($F{uid},$F{list}); my $c="", $r=""; my @mi=split(/\|z\|/,$G[$f]); for my $a (@mi){ my @b=split(/\|-\|/,$a); if($b[0]eq $m){ $r=$a; } else {$c.="$a|z|"; } } $G[$f]=$c; &PutOneData($F{uid},$F{list}); return $r; } sub DM{ &printhead(0); $r=&dM($F{mf},$F{m}); if($r ne""){ print "
Message #$F{m} deleted from your ($F{uid}) mbox\n";} $F{h}=""; &mB; } sub uS{ if( $F{h} ne ""){&printhead(0);} print "Click a user name to send a message to him/her
"; open(FI,"<$dbhm/$F{list}/usr"); while(
){ my @mi=split(/\|-\|/,$_); if($mi[2] ne"") { print " - $mi[2] \n"; } } close(FI); } sub chineseform{ print FO "
For some versions of browsers, the javascript program not working properly. Please input into the following box directly by paste-copy or by other Chinese input software.
This area is to help you to input Chinese GB. You also need to enable Javascript. ) please leave the input box below empty, or copy the Chinese GB from other software.
Type Pinyin & tone, eg. zhang1 Press<Tab>
Then Click this box to type a number (see bottom): Press<Tab>
If you could not view: ÖÐÎÄ×Ö, please do not type anything into this box ->\n"; } sub newbox{ my ($i, $v, $o, $c, $r)=@_; # print FO "$I[$i]{name} $v\n"; $t=$I[$i]{type}; my $h="(Non empty field)$dsp";} if( ($I[$i]{edit_op} eq "nc") && ($o eq "o") ) {if( $rootin ) { $no=""; } else { $no="type=hidden"; } if(($t eq "dt") or ($t eq "id")){ $no="type=hidden"; } if(($t eq "ne") or ($t eq "nc")){ $no="type=hidden"; } print FO "$h $no value=\"$v\"> $v (change by root, or auto set)\n
\n"; } else { open(FI,"<$sfl"); @x=
"; print FO "\n$dsp
\n"; return;} if( $dsp ne "" ) {if(($t eq "sl") or ($t eq "ms")) { $dsp=~ s/: .*//; } print FO "\n$dsp
\n";} if ($t eq "ch"){ &chineseform; print FO "$h value=\"$v\">"; } elsif($t eq "fl") { print FO "$h type=file>"; } elsif(($t eq "ta")or($t eq "tA")or($t eq "TA")) { if($c eq ""){$c=42; } if($r eq ""){$r=5; } print FO "";} elsif($t eq "Ta") { if($c eq ""){$c=72; } if($r eq ""){$r=12; } print FO "";} elsif($t eq "id"){ if ( $v eq "" ) { print FO "$h type=hidden value=new>New"; } else { print FO "$h type=hidden value=$v>$v"; } } elsif($t eq "pw"){ if($c eq ""){$c=12; } print FO "$h type=password size=$c value=\"$v\" >"; if($I[$i]{conf} ne ""){ print FO "$I[$i]{conf} ${h}_cf type=password size=$c value=\"$v\" >"; } } elsif($t eq "dt"){ print FO "$h type=hidden value=$today>$today"; } elsif($t eq "dT"){ if($v eq "" ) {print FO "$h size=10 value=$today>"; } else {print FO "$h size=10 value=$v>"; } } elsif($t eq "ph"){ if ( $v eq "" ) { print FO "? $h type=hidden value=u> "; } else { print FO "$h value=$v>$v."; } } elsif($t eq "em"){ if($c eq ""){$c=42; } print FO "$h size=$c value=\"$v\">"; print FO "$fmhid=oemail value=\"$v\">"; } elsif($t eq "sl"){ my ($a,$n,$s)=split(' : ',$I[$i]{description}); my @x=split(', ',$s); if($x[$n]=~s/=default//) {$xdef[$x[$n]]="checked"; } for($j=0; $j<$n; $j++) { if($I[$i]{breaks} eq "break" ) {print FO "
\n"; } else{ print FO " ||"; } print FO "$h type=radio $xdef[$j] value=\"$x[$j]\""; if ($v eq $x[$j]) {print FO " checked"} print FO ">$x[$j]"; } } elsif($t eq "ms"){ my ($a,$n,$s)=split(' : ',$I[$i]{description}); my @x=split(', ',$s); $mnz=($n > 5) ? 5 : $n; print FO "";} elsif($t eq "mf"){ my @mf=split(/$I[$i]{muls}/,$v); for (my $z=0; $z<$I[$i]{mulf}; $z++){ my $fe="mulf$z"; my $fs="muls$z"; print FO "$I[$i]{$fe}: ${h}_$z size=$I[$i]{$fs} value=\"$mf[$z]\" >$fieldseparator"; } } elsif($t eq "mu"){ my @mu=split(/$I[$i]{sepa}0/,$v); my $s=@mu; for (my $z=0; $z<=$I[$i]{incr0}; $z++){ ## print "\n\n\n\n "; if($s>0) { my $x=$mu[$s-1]; $x=~s/$I[$i]{sepa}1//g; if($x eq ""){ $s--; } } } $s+=$I[$i]{incr0}; print FO "\n $fmhid=n${i}_n value=$s> \n"; for(my $w=0; $w<$s; $w++) { my $ww=$w+1; if($I[$i]{levl} eq "") { print FO "\n
$ww ${h}_$w size=$c value=\"$mu[$w]\"> $fmhid=n${i}_${w}_o value=\"$mu[$w]\">"; } else { my @mu2=split(/$I[$i]{sepa}1/,$mu[$w]); my $s2=@mu2; if($s2 eq 0){ $s2=1; } $s2+=$I[$i]{incr1}*$I[$i]{cycl}; if( $I[$i]{fixd1} ne "") { $s2=$I[$i]{fixd1}; } print FO "\n$fmhid=n${i}_${w}_n value=$s2>\n"; for(my $w2=0; $w2<$s2; $w2++) { my $ww2=$w2+1; if($w2 eq 0) { print FO "
$ww ${h}_$w size=$c value=\"$mu2[$w2]\"> $fmhid=n${i}_${w}_o value=\"$mu2[$w2]\">"; } else{ my $x=$w2; while($x > $I[$i]{cycl}) { $x-=$I[$i]{cycl};} my $sp="spac$x"; my $ss=$I[$i]{$sp}; if( $ss eq "") { $ss=$c; } if( $ss =~ /x/ ) { my ($r,$c)=split(/x/,$ss); print FO "$I[$i]{$x} "; } else { print FO "$I[$i]{$x} ${h}_${w}_$w2 size=$ss value=\"$mu2[$w2]\"> $fmhid=n${i}_${w}_${w2}_o value=\"$mu2[$w2]\">"; } } } } } } else { if($c eq ""){$c=42; } print FO "$h size=$c value=\"$v\" >\n";} if($t eq "cm"){ print FO "$fmhid=on$i value=\"$v\">\n"; } } sub printframe{ if ( $H{indexch} > 0 ) { print ""; print "; print "@x"; close(FI); } } sub newform{ my ($wk, $hid, $subm)=@_; if ($wk eq ""){ $wk="newdata"; } if ($subm eq ""){ $subm="Input"; } if ( $H{input_pw} ne "" ) {&rootpw("$H{input_pw}", "newform", "input new"); $rootin=1; } &inputhead; print FO "Input /edit information into database: $H{description} $H{inputHead}\n"; print FO "\n \n\n$fmhd\n$fmhid=w value=$wk> $fmhid=pD value=$F{code_pw}> $hid $fmsub=subm value=\"$subm\"> \n
$fmsub=subm value=\"$subm\"> \n"; close(FO); & printframe; } sub check_data{ for(my $j=0; $j<$H{num_fields}; $j++) { my $i=$j+1; my $ni="n$i";my $ci="c$i"; $F{$ni}=~ s/ //g; if( $I[$i]{type} eq "dt" ) { $F{$ni}=$today; } if( $I[$i]{type} eq "em" ) { $F{$ni} =~ tr [A-Z] [a-z] ; $F{$ni} =~ s/ /,/g;} if( $I[$i]{type} eq "pw" ) { $F{$ni} = &uncode_p($F{$ni}); my $ni2="${ni}_cf"; $F{$ni2} = &uncode_p($F{$ni2}); if($debug){ print "\n"; } if( $F{$ni} ne $F{$ni2} ) { if($I[$i]{conf} ne ""){ $usrerrmsg="The $I[$i]{name}( $I[$i]{description}) must be matched. Please go back and input again."; &Finish; }}} if(( $I[$i]{nonull} eq "non" ) and ($F{$ni} eq "")) { $usrerrmsg="Field $I[$i]{name}( $I[$i]{description}) must be non-empty. Please go back and input again."; &Finish; } if ( $I[$i]{type} eq "nm" ) { $F{$ni} =~ s/ / /g; $F{$ni}=&frontchomp($F{$ni}); $F{$ni}=&capitalit($F{$ni}); my($l, $f)=split(/,/,$F{$ni}); if($f eq ""){ $f=$l; $l=~ s/.* //; $f=~ s/ $l//; $l=&frontchomp($l); $l=&capitalit($l); $F{$ni}="$l, $f"; } } if ( ($I[$i]{nosp} ne "") and ($F{$ni} =~ / /)) { $usrerrmsg="The $I[$i]{name}( $I[$i]{description}) field should not contain space. Please go back and input again."; &Finish; } if ( $I[$i]{lowc} ne "" ) { $F{$ni} =~ tr [A-Z] [a-z] ; } if (( $I[$i]{nonr} ne "" ) and ( $F{edit_data} eq "" )){ my @u=&all_data($F{list},$i); for my $a (@u) { print "\n"; for ($i=1; $i<=$H{num_fields}; $i++) { my $c="c$i"; my $v="n$i"; if(($I[$i]{noinput}eq "noi")or (($I[$i]{edit}eq "nc") and ($F{$v} ne "")) ) { print FO "$I[$i]{hidden}$fmhid=$c value=\"$F{$c}\"> $fmhid=$v value=\"$F{$v}\">\n ";} else { print FO " Field Info \n"; } } print FO " $i. $I[$i]{name} "; # print FO "\n"; # &newVbox("$F{$c}"); print FO " \n"; print FO ""; &newbox($i,"$F{$v}", "i", $I[$i]{space}, $I[$i]{rows}); if($I[$i]{ndb_pw}eq "pw"){ print FO " Password: $fmpas=ndb_pw size=9>\n"; } print FO " - ,$a,$F{$ni},"; if( $a eq $F{$ni}) { $usrerrmsg="The $I[$i]{name}( $I[$i]{description}) field repeated values. Someone already used it. Please go back and input again."; &Finish; } } } if ( $I[$i]{type} eq "mf" ) { if( $F{$ni} eq "" ) { $F{$ni}=""; ## Otherwise implicit hiden data. for(my $k=0; $k<$I[$i]{mulf}; $k++) { my $in="n${i}_$k"; if($k>0){ $F{$ni}.="$I[$i]{muls}";} $F{$ni}.="$F{$in}"; } } } if ( $I[$i]{type} eq "mu" ) { my $in1="n${i}_n"; for(my $k=0; $k<$F{$in1}; $k++) { my $in="n${i}_$k"; if($I[$i]{levl} ne "" ){ my $in2="n${i}_${k}_n"; for(my $z=1; $z<=$F{$in2}; $z++) { my $in3="n${i}_${k}_${z}"; $F{$in}.="$I[$i]{sepa}1$F{$in3}"; } } $F{$ni}.="$F{$in}$I[$i]{sepa}0"; } } } } sub all_data{ my ($l,$i)=@_; if($l eq "") { return ""; } open(FA,"<$dbhm/${l}.a"); my @u=(); while(
){ my @a=split(/\|-\|/,$_); for(my $j=0; $j<$#a; $j++){ $a[$j]=~s/RrR/\n/g; } for(my $j=0; $j<$H{num_fields}; $j++) { if(( $j+1 eq $i ) or ( $i eq "")) { push @u, $a[$j]; } } } close(FA); return @u; } sub capitalit{ my($x)=@_; my $f=substr($x,0,1); my $y=substr($x,1,100); $f=~ tr [a-z] [A-Z]; print " - $x Convert $f$y
"; return "$f$y"; } sub frontchomp{ my($x)=@_; for(my $i=0; $i<10; $i++){ my $y=substr($x,0,1); print "\n$i =$y=
\n"; if( $y eq " "){ $x=substr($x,1,100); } } return $x; } sub superedit{ my ($id)=@_; my $wk="ulogin"; if($id eq ""){ if( $H{super_root} ne ""){ $wk="ulogin"; &rootpw("$H{super_root}", $F{password}, "edit by root"); $id=$F{id}; $F{rEdit}="$fmhid=rEd value=1>$fmhid=idh value=$id>"; } else { $usrerrmsg="Not allowed for this database."; &Finish; } } my @u=&all_data($F{list},""); my $endu=@u; my $s=0; while( $s < $endu ) { my $idx=$s+$H{indexid}-1; if($u[$idx] eq $id ) { for ($i=1; $i<=$H{num_fields}; $i++) { my $v=$s+$i-1; my $ni="n$i"; my $ci="c$i"; $F{$ni}=$u[$v]; $F{$ci}=$all_data_v[$v]; } my $hid="$fmhid=uname value=$F{uname}>$F{rEdit} $fmhid=edit_data value=y>"; &newform($wk, $hid, "Save" ); &Finish; } $s += $H{num_fields}; } $usrerrmsg="ID $id not found."; &Finish; } ################### put delete data back ####################### sub restore_data{ my ($id)=@_; system("tail -1 $dbhm/$F{list}.a.d >> $dbhm/$F{list}.a"); } sub uEm{ if ($F{subm} eq "" ) { &printhead; print "
Find password in $H{description} system.
$fmhd $fmhid=w value=uEm> Any one domain name you registered: $fminp=udom size=9> $fmsub=subm value=\"Email password\">"; return; } $usererrmsg="To be done soon ... Email support\@superprism.net at the moment. "; &Finish; } sub cmuemails{ my ($no, $no, $e, @c)=&webgetfile("cauchy.math.udel.edu", 80, "/cgi-bin/dm?l=f/m/s&w=cfn-fl&fl=$F{f}", ""); open(FM, "|/usr/lib/sendmail $e"); print FM @c; close(FM); print "\nSENT.\n"; &Finish; } sub emails{ open(FM, "|/usr/lib/sendmail $F{e}"); print FM "To: $F{e}\nReply-To: $F{s}\nSubject: $F{s}\nFrom: $F{f}\n\n"; for (my $i=1; $i<=$F{t}; $i++){ print FM "$i $F{$i}\n\n"; } close(FM); print "$F{0}\n"; &Finish; } sub emailone{ print "
Email one from system support account.
$fmhd $fmhid=w value=emails> $fmhid=0 value=\"Email was sent.\n\"> To: $fminp=e size=55>
Subject: $fminp=s size=69>
$fmhid=f value=\"ISP Support\"> $fmhid=t value=1> Message:
$fmsub=subm value=\"Email\">"; Finish; } sub ulogin{ if ($F{subm} eq "" ) { &printhead; print "Login in $H{description} system.
$fmhd $fmhid=w value=ulogin> Login (user) name: $fminp=uname size=9> Password: $fmpas=password size=12> (Forgot? See below.)
$fmsub=subm value=\"Login\">
If you forget your password, or user name, please fill this form: $fmhd $fmhid=w value=emails> $fmhid=0 value=\"Thank you. Please wait a few minutes. A system person will email you your user name and password as soon as possible.\n\"> $fmhid=e value=support\@superprism.net> $fmhid=s value=\"Find user name and password\"> $fmhid=f value=\"ISP Support\"> $fmhid=t value=3> Domain Name: $fminp=1 size=19>
Email my user name and password to: $fminp=2 size=22>
Email address used in registration (if different from the above one) : $fminp=3 size=22>
$fmsub=subm value=\"Email\">"; return; } if($F{rEd}){ if($debug){ print "rEd, $F{idh},-id,$F{list}.a"; } &delete_data("$F{list}.a", $F{idh}); $newdatalink=" Check this data
List all data
\n"; &newdata("$F{list}", "old", $F{idh}); &listdata; return; } my @u=&all_data($F{list},""); my $endu=@u; my $s=0; while( $s < $endu ) { my $un=$s+$H{indexun}-1; my $pw=$s+$H{indexpw}-1; # print "- $H{indexpw},$pw, $u[$pw] $F{password}"; if($u[$un] eq $F{uname} ) { my $id=$s+$H{indexid}-1; if ($u[$pw] eq $F{password} ) { if($F{subm} eq "Save" ) { $Restore_data=1; &delete_data("$F{list}.a", $u[$id]); $newdatalink=" Check your data"; &newdata("$F{list}", "old", $u[$id]); return; } else { &uloginpage($u[$id]); return; } } else { $usererrmsg="Wrong password."; &Finish; } } $s += $H{num_fields}; } $usererrmsg="User name not found. "; &Finish; } sub uloginpage{ my ($id)=@_; &superedit($id); return; } sub max_data{ my ($d, @a)=@_; my $m=$a[0][$d]; for(my $j=0; $j<=$#a; $j++){ $a[$j][$d]=~s/VvV.*//; if( $a[$j][$d] > $m) {$m=$a[$j][$d] } } return $m; } sub new_id{ my ($db)=@_; my @n=&read_table(1,0,0,"$db.a"); my $nid=&max_data($H{indexid}-1,@n); my @n=&read_table(1,0,0,"$db.d"); my $oid=&max_data($H{indexid}-1,@n); if ($oid > $nid) { $nid=$oid; } $nid++; return $nid; } sub delete_data{ my ($db, $id)=@_; my @a=&read_table(1,0,0,$db); my @b=(); my $x=$H{indexid}-1; for(my $j=0; $j<=$#a; $j++){ if($a[$j][$x] eq $id){ for(my $l=0; $l<$H{num_fields}; $l++) { $b[$l]=$a[$j][$l]; } &append_table("$db.d", @b); $a[$j][$x]=""; }} &write_table($db,@a); } sub append_table{ my ($db,@a)=@_; open(FO,">>$dbhm/$db"); if($debug) { print "Append ", @a, "
"; } for(my $k=0; $k<=$#a; $k++){ $a[$k]=~s/\n/RrR/g; print FO "$a[$k]|-|";} print FO "\n"; close(FO); } sub write_table{ my ($db,@a)=@_; open(FO,">$dbhm/$db"); my $x=$H{indexid}-1; for(my $j=0; $j<=$#a; $j++){ if($a[$j][$x] ne ""){ for(my $k=0; $k<=$#{$a[$j]}; $k++){ $a[$j][$k]=~s/\n/RrR/g; print FO "$a[$j][$k]|-|";} print FO "\n"; } } close(FO); } sub newdata{ my ($db,$old, $oldid)=@_; if ($db eq "") { $db=$F{list}; } &printhead(0); &check_data; open(FL, ">>$dbhm/$db.r"); flock FL, 2; # $#{$x[3]} my $id="n$H{indexid}"; my $nm="n$H{indexnm}"; if($F{$nm} eq ""){$nm=1;} my $nid=$F{$id}; if($old eq "") { $nid=&new_id($db); print FL "$nid, ", `date`; $F{$id}=$nid;} else{ if($oldid eq "") { &delete_data("$db.a",$nid); } } open(FD, ">>$dbhm/$db.a"); for(my $j=0; $j<$H{num_fields}; $j++) { $i=$j+1; $ni="n$i"; $ci="c$i"; $F{$ni}=~ s/\n/RrR/g; print FD "$F{$ni}"; if ($F{$ci} ne "") { print FD "VvV$F{$ci}"; } print FD "|-|"; } print FD "|-|\n"; close(FD); close(FL); my $x=""; if($F{$nm} ne ""){ $x=" for $F{$nm}, "; } if($debug){ print "
Data $x inserted into database $F{list} (list all data)
($H{description}),with id $F{$id}(check new data).
input more into the database $F{list}.
\n"; } &domain_files($oldid); print "$newdatalink\n"; } sub domain_files{ my ($oldid)=@_; my $tlin="########## No change below this line #######dNsT####### \n###### The rest generated by szhang program. #######\n"; my $blin="### /etc/rc.d/rc3.d/S81named restart ####### \n### /var/www/cgi-bin/d_out/dns/named.conf >> /etc/named.conf \n### ln -s /var/www/cgi-bin/d_out/dns/xxxx.hosts xxxx.hosts \n### at directory /var/named/ \n###/etc/rc6.d/K15httpd restart \n### /var/www/cgi-bin/d_out/www/httpd.conf >> /etc/httpd/conf/httpd.conf \n### ln -s /var/www/cgi-bin/d_out/www/xxxx xxxx \n### at directory /www/ \n### No change here. Only above 1st no change line ######\n"; my $blin="### end for one insertion by szhang ######\n"; my $llin="### last line of change by szhang ###dNsL###\n"; my $ip="$mips"; if($F{rEd}){ print "Summary
"; } if($H{dns} ne ""){ my $i=$H{dns}; my @a=&all_data($F{list}, $i); open(FO,">$dbhm/dns/named.conf"); open(FI, ") { if(/dNsT/){ $originln=0; } if($originln){ print FO; } if(/dNsL/){ $originln=1; } } close(FI); print FO "$tlin"; for my $d (@a) { my @mu=split(/$I[$i]{sepa}0/,$d); my $s=@mu; for(my $w=0; $w<$s; $w++) { my $ww=$w+1; my @mu2=split(/$I[$i]{sepa}1/,$mu[$w]); my $s2=@mu2; my $ss=($s2-1)/2; my $dm="$mu2[$0]"; if( substr($mu2[$0], 5,6) ne "" ){ print FO "zone \"$mu2[$0]\" {\n"; print FO "\ttype master;\n"; print FO "\tfile \"$mu2[$0].hosts\"; };\n"; print FO "$blin\n"; open(FS,">$dbhm/dns/$mu2[$0].hosts"); print FS "\@ IN SOA ns.$dm. root.$dm. ( 1997022700 ; Serial 28800 ; Refresh 14400 ; Retry 3600000 ; Expire 86400 ) ; Minimum NS ns.$dm.\n;\nns\t\tA\t$cauchyip\n"; my $hs=1; my $wwwhs=1; for(my $w2=0; $w2<$ss; $w2++) { my $x=2*$w2+1; my $y=$x+1; if($mu2[$x] eq "") { $hs=0; print FS "$dm.\t\tA\t$mu2[$y]\n"; if($F{rEd}){ print "
\n"; } print "- DNS: $dm $mu2[$y]\n"; } } else { if( $mu2[$x] =~ /www/i ){ $wwwhs=0; } print FS "$mu2[$x]\t\tA\t$mu2[$y]\n"; if($F{rEd}){ print "
- DNS: $mu2[$x].$dm $mu2[$y]\n"; } } } if($wwwhs){ print FS "www\t\tA\t$ip\n"; if($F{rEd}){ print "
- DNS: www.$dm $ip\n"; } } if($hs){ print FS "$dm.\t\tA\t$ip\n"; if($F{rEd}){ print "
- DNS: $dm $ip\n"; } } close(FS); } } } } print FO "$llin"; close(FO); if($H{mailhost} ne ""){ my $i=$H{mailhost}; my @a=&all_data($F{list}, $i); open(FO,">$dbhm/mail/domain"); for my $d (@a) { my @mu=split(/$I[$i]{sepa}0/,$d); for my $w (@mu) { my @mu2=split(/$I[$i]{sepa}1/,$w); my $s2=@mu2; my $ss=($s2-1)/2; my $dm="$mu2[$0]"; if ( substr($dm, 4,6) ne "" ){ print FO "$dm\n"; if($F{rEd}){ print "
- Email $dm
\n"; } open(FS, ">$dbhm/mail/$dm"); my $alldom=1; for(my $w2=0; $w2<$ss; $w2++) { my $x=2*$w2+1; my $y=$x+1; if($mu2[$x] eq "") { $alldom=0; } $dm =~ s/.*\@//; print FS "$mu2[$x]\@$dm $mu2[$y]\n"; if($F{rEd}){ print "
\n"; } } } } close(FO); } if($H{webhost} ne ""){ my $i=$H{webhost}; my @a=&all_data($F{list}, $i); open(FO,">$dbhm/www/httpd.conf"); open(FI, ") { if(/dNsT/){ $originln=0; } if($originln){ print FO; } if(/dNsL/){ $originln=1; } } close(FI); print FO "$tlin"; for my $d (@a) { my @mu=split(/$I[$i]{sepa}0/,$d); for my $w (@mu) { my @wi=split(/$I[$i]{sepa}1/,$w); my $www="$wi[0]"; if( substr($www, 5,6) ne "" ){ print FO "# Virtual host $www \n- $mu2[$x] $mu2[$y]\n"; } } if($alldom) { print FS "\@$dm support\@superprism.net\n"; } close(FS); if($F{rEd}){ print "
\n\tDocumentRoot /www/free.www/$www \n\tServerAdmin support\@superprism.net \n\tServerName $www \n\t \n$blin"; my $dr="$dbhm/www/$www"; if( ! ( -f $dr ) ){ system("mkdir $dr; chmod a+w $dr"); } open(FS,">$dr/index.html"); print FS "$wi[1]\n"; if($F{rEd}){ print "- Web hosting: $www at Superprism.\n"; } close(FS); } } } print FO "$llin"; close(FO); } if($F{rEd}){ print "
- The DNS, email, and webpages will be set up overnight.
For emergency please email support\@superprism.net, so that your domain settings can be done sooner.\n"; }