home *** CD-ROM | disk | FTP | other *** search
/ Java 1.2 How-To / JavaHowTo.iso / 3rdParty / Coocoo / coocoo.cgi < prev    next >
Text File  |  1998-04-17  |  24KB  |  1,121 lines
  1. #!/usr/bin/perl5
  2. &ReadParse(*regdata);
  3.  
  4. ####################################################
  5. #  coocoo.cgi - version 1.51 (build 002)
  6. #
  7. #  Mark Qian 1997 All rights reserved
  8. #                                          
  9. ####################################################
  10.  
  11. if ($regdata{'action'} eq 'test')
  12. {
  13.   $dd = $regdata{'datadir'};
  14.   if ($dd eq '')
  15.   {
  16.     $dd = '"./data';
  17.   }
  18.  
  19.   print "Content-type: text/html\nPragma: no-cache\n\n";
  20.   unless (open (DataFile, ">>" . $dd . "/test_xxxx")) 
  21.   {
  22.      print ("The directory pointed by parameter datadir doesn't exist or is not writable...Please make your datadir writable.\n");
  23.      die ("cant open  file\n");
  24.   }
  25.   close DataFile;
  26.   `rm $dd`;
  27.   print "OK";
  28.   die ("OK\n");
  29. }
  30.  
  31. if ($regdata{'action'} eq 'getbanner')
  32. {
  33.   print "Content-type: text/html\nPragma: no-cache\n\n";
  34. }
  35. else
  36. {
  37.   print "Content-type: text/text\nPragma: no-cache\n\n";
  38. }
  39.  
  40. #print "action:";
  41. #print "user:" . $regdata{'user'} ."\n";
  42. #print "chatfile:" . $regdata{'chatfile'} ."\n";
  43. #print "action:" . $regdata{'action'} ."\n";
  44. #print "line:" . $regdata{'line'} ."\n";
  45. #print "userfile:" . $regdata{'userfile'} ."\n";
  46. $delimit = "^#^";
  47.  
  48. $datapath = $regdata{'datadir'};
  49. $chatfile = $datapath . $regdata{'chatfile'}; 
  50. $userfile = $datapath . $regdata{'userfile'}; 
  51. $userfile2 = $datapath . $regdata{'userfile'}  . '2';
  52. $callfile = $datapath . $regdata{'callfile'}; 
  53.  
  54. if ($regdata{'action'} eq 'getCaller' )
  55. {
  56.  
  57.  
  58.    unless (open (CallFile, $callfile)) 
  59.    {
  60.     # print ("cant open file4.5: ", $callfile, "\n");
  61.      &create_file($callfile, "",'getCaller' );
  62.      print "###***^^^\n";
  63.      die ("cant open  file\n");
  64.    }
  65.    @lines = <CallFile>;
  66.    close CallFile;
  67.  
  68.    unless (open (CallFile, ">" . $callfile)) 
  69.    {
  70. #     print ("cant open file5.8: ", $callfile, "\n");
  71.      return;
  72.    }
  73.  
  74.    for ($i=0; $i<=$#lines; $i++)
  75.    {
  76.  
  77.     chop($lines[$i]);
  78.     @tt = split(/\^\#\^/,$lines[$i]);
  79. #print ("tt[0]:", $tt[0], "**\n");
  80. #print ("regdata{'user'}:", $regdata{'user'}, "**\n");
  81. #print ("tt[1]:", $tt[1], "**\n");
  82.  
  83.  
  84.     if ($tt[1] eq $regdata{'user'})
  85.     {
  86.       
  87.       if ($tt[2] ne "read")
  88.       {
  89.         print CallFile ($tt[1], "^#^", $tt[0], "^#^", "read\n");
  90.         print ($tt[0], "\n");
  91.       }
  92.       else
  93.       {
  94.         print ($tt[0], " Replied and \n");
  95.       }
  96.     }
  97.     else
  98.     {
  99.       print CallFile ($lines[$i], "\n");
  100.     }
  101.   }
  102.   close CallFile;  
  103.   print "###***^^^\n";
  104.   return;
  105.   
  106. }
  107.  
  108. if ($regdata{'action'} eq 'get' )
  109. {
  110.  
  111.   unless (open (DataFile, $chatfile)) 
  112.   {
  113. #     print ("cant open file1: ", $chatfile, "\n");
  114. #     &create_file($chatfile, "");
  115.      print "###***^^^\n";
  116.      die ("cant open  file $chatfile\n");
  117.   }
  118.  
  119.  
  120.   @lines = <DataFile>;
  121.   close DataFile; 
  122.   $lineNum = 0 + $regdata{'linenum'};   
  123.  
  124.   
  125.  
  126.   $firstLine = -1;
  127. #print ("enter get in cgi  lineNum=", $lineNum, "   #lines=",  "$#lines", "\n"); 
  128.  
  129.   for ($kk=$#lines-1; $kk>-1 && $firstLine==-1; $kk--)
  130.   {
  131.      chop($lines[$kk]);
  132.      @LLL = split (/\^\#\^/, $lines[$kk]);
  133.      $curNum = 0 + $LLL[0];
  134. #print ("enter get in cgi lineNum=",  "$lineNum", "  curNum=", "$curNum", "\n");   
  135.      if ($lineNum > $curNum)
  136.      {
  137. #print ("in if\n");
  138.        $firstLine = $kk + 2;
  139.       
  140.      }
  141.    }
  142.  
  143.    for ($kk=$firstLine; $kk<=$#lines; $kk++)
  144.    {
  145.       print ($lines[$kk], "\n");
  146.  
  147.    }
  148.  
  149.    if ($kk == $firstLine && ! $kk<=$#lines)
  150.    {
  151.       print ("###***^^^", "\n");
  152.    }
  153.   
  154.    return;
  155.   
  156. }
  157.  
  158. if ($regdata{'action'} eq 'renewlist' )
  159. {
  160.    $userfile = $datapath . $regdata{'file'}; 
  161.    $userfile2 = $datapath . $regdata{'file'}  . '2';
  162.  
  163.    `chmod 777 $userfile2`;
  164.  
  165.    `cp $userfile2 $userfile`;
  166.    `rm $userfile2`;
  167.    print ("###***^^^", "\n");
  168.    return;
  169.       
  170. }
  171.  
  172.  
  173. if ($regdata{'action'} eq 'updatelist')
  174. {
  175.  
  176.    $userfile = $datapath . $regdata{'file'}; 
  177.    $userfile2 = $datapath . $regdata{'file'}  . '2';
  178.  
  179.    `chmod 777 $userfile`;
  180.    `chmod 777 $userfile2`;
  181.    `chmod 777 $chatfile`;
  182.  
  183.    if ($regdata{'action2'} eq "room")
  184.    {
  185.      $ttt = $regdata{'room'} . "\n";
  186.      $nnn = $regdata{'room'};
  187.    }
  188.    elsif ($regdata{'action2'} eq "user")
  189.    {
  190.      $ttt = $regdata{'user'} . $delimit . $regdata{'email'} . "\n";
  191.      $nnn = $regdata{'user'};
  192.    }
  193.    else
  194.    {
  195.  
  196.      print ("###***^^^", "\n");
  197.      return;
  198.    }
  199.  
  200.  
  201.     if (!open (DataFile, $userfile2)) 
  202.     {
  203.       unless (open (DataFile, ">" . $userfile2)) 
  204.       {
  205.         print ("cant open file6: ", $userfile2, "\n");
  206.         return;
  207.       }
  208. #print ("###", $ttt, "###");  
  209.       print DataFile ($ttt);
  210.       close DataFile;
  211.     }
  212.     else
  213.     {
  214.       @lines = <DataFile>;
  215.       close DataFile;
  216.  
  217.       unless (open (DataFile, ">" . $userfile2)) 
  218.       {
  219.         print ("cant open file6: ", $userfile2, "\n");
  220.         return;
  221.       }
  222. #print ("#### IN CGI: after open userfile lines=", $#lines, "\n");  
  223.   
  224.       $UserExist = 0;
  225.       for ($i=0; $i<=$#lines; $i++)
  226.       {
  227.        print DataFile ($lines[$i]);
  228.        chop($lines[$i]);
  229.        @tt = split(/\^\#\^/,$lines[$i]);
  230.        
  231. #print ("***", $tt[0], "***", $nnn, "***\n");
  232.         
  233.         
  234.         if ($tt[0] eq $nnn)
  235.         { 
  236.           $UserExist = 1;
  237.         }
  238.       }
  239.  
  240.       if ($UserExist == 0)
  241.       {
  242.        print DataFile ($ttt);
  243.       }
  244.       close DataFile;
  245.   }
  246.  
  247.   
  248. #print ( "enter getuser ... in cgi");
  249.    unless (open (DataFile, $userfile)) 
  250.    {
  251.      `cp $userfile2 $userfile`;
  252.      unless (open (DataFile, $userfile)) 
  253.      {
  254.        print ("###***^^^", "\n");
  255.        return;
  256.      }
  257.      
  258.    }
  259.    @lines = <DataFile>;
  260.    close DataFile;
  261.  
  262.    $UserExist = 0;
  263.  
  264.    for ($i=0; $i<=$#lines; $i++)
  265.    {
  266.      chop($lines[$i]);
  267.      @tt = split(/\^\#\^/,$lines[$i]);
  268. #print ("***", $lines[$i], "***","\n");
  269. #print ("***", $tt[0], "***", $nnn, "***\n");
  270.      if ($tt[0] eq $nnn)
  271.      { 
  272.           $UserExist = 1;
  273.      }
  274.        
  275.      print ($tt[0], "\n");
  276.    }
  277.  
  278.    if ($UserExist == 0)
  279.    {
  280.        print $nnn;
  281.        return;
  282.    }
  283.  
  284.    if ($#lines==0)
  285.    {
  286.      print ("###***^^^", "\n");
  287.    }
  288.    return;
  289.   
  290. }
  291.  
  292. if ($regdata{'action'} eq 'getlines')
  293. {
  294.  
  295. $TheFile = $datapath . $regdata{'file'};
  296.   unless (open (DataFile, $TheFile)) 
  297.   {
  298.      print ("###***^^^", "\n");
  299.      die ("cant open  file\n");
  300.   }
  301.   @lines = <DataFile>;
  302.   close DataFile;
  303.  
  304.   
  305.   for ($i=0; $i<=$#lines; $i++)
  306.   {
  307.     print $lines[$i];
  308.   }
  309.  
  310.  
  311.   print ("###***^^^", "\n");
  312.   return;
  313. }
  314.  
  315. if ($regdata{'action'} eq 'getnews')
  316. {
  317.  
  318.   @Files = `ls $regdata{'newsdir'}`;
  319.  
  320.   srand(time ^ $$);
  321.   $ttt = $Files[int rand $#Files];
  322.  
  323.   $FileName = $regdata{'newsdir'} . $ttt;
  324.     unless (open (DataFile, $FileName)) 
  325.     {
  326.       print ("cant open: ", $ttt, "\n");
  327.       return;
  328.     }
  329.      
  330.     @lines = <DataFile>;
  331.     close DataFile;
  332.  
  333.   for ($i=0; $i<=$#lines; $i++)
  334.   {
  335.     print $lines[$i];
  336.   }
  337.  
  338.   print ("###***^^^", "\n");
  339.   return;
  340. }
  341.  
  342.  
  343.  
  344. if ($regdata{'action'} eq 'join')
  345. {
  346. #print ( "enter join ... in cgi");
  347.   $user_exist = 0;
  348.   $file_exist = 0;
  349.   $lineNum = -1;
  350.  
  351.   $roomfile = $datapath . $regdata{'roomfile'};
  352.   
  353.   unless (open (DataFile, $roomfile)) 
  354.   {
  355.      &create_file($roomfile, $regdata{'primaryroom'} . "\n", 'Join create room file');
  356.      $lineNum = -1;
  357.      $tt = $regdata{'user'} . $delimit . $regdata{'email'} . "\n";
  358.   
  359.      &create_file($userfile, $tt, 'Join - create user file');
  360.   
  361.      print ("###***^^^", "\n");
  362.      return;
  363.   }
  364.   @rooms = <DataFile>;
  365.   close DataFile;
  366.  
  367.   
  368.   for ($i=0; $i<=$#rooms; $i++)
  369.   {
  370.     if (open (DataFile2, $rooms[$i])) 
  371.     {
  372.       $file_exist = 1;
  373.       $lines = <DataFile2>;
  374.       while ($lines ne "")
  375.       {
  376.         @tt = split(/\^\#\^/,$lines);
  377.         if ($tt[0] eq $regdata{'user'})
  378.         {
  379.           $user_exist = 1;
  380.         }
  381.  
  382.         $lines = <DataFile2>;
  383.       }
  384.  
  385.       close DataFile2;
  386.     }
  387.     else
  388.     {
  389.      &create_file($rooms[$i], "", 'Join - create room');   
  390.     }
  391.   }
  392.  
  393.   if ($user_exist >0)
  394.   {
  395.     $lineNum = -100;
  396.     print "$lineNum";
  397.     return;
  398.   }
  399.  
  400.        
  401.   $tt = $regdata{'user'} . $delimit . $regdata{'email'} . "\n";
  402.   
  403.  
  404.   if (!open (DataFile, ">>$userfile"))
  405.     {
  406.         print ("cant open file4: ", $userfile, "\n");
  407.         return;
  408.     }
  409.  
  410.  
  411.   print DataFile  $tt;
  412.   close DataFile;
  413.  
  414.   if (!open (DataFile, "$chatfile"))
  415.   {
  416.         $lineNum = -1;
  417.   }
  418.   else
  419.   {
  420.     @lines = <DataFile>;
  421.     close DataFile; 
  422.     @List = split (/\^\#\^/, $lines[$#lines]);
  423.     $lineNum = 1 + $List[0];   
  424. #print ("$lineNum=", $lineNum, "\n");
  425.  
  426.   }
  427.  
  428.  
  429.     print ("$lineNum", "\n");
  430.    
  431. }
  432.  
  433.  
  434. if ($regdata{'action'} eq 'put' || $regdata{'action'} eq 'join' || $regdata{'action'} eq 'leave' || $regdata{'action'} eq 'sys')
  435. {
  436. #print ( "enter put ... in cgi");
  437.   $LN = -1;
  438.   if (open (DataFile, $chatfile))
  439.   {
  440.     @lines = <DataFile>;
  441.     close DataFile;      
  442.     if ($#lines>0)
  443.     {
  444.       $LN = 1 + $#lines;
  445.     }
  446.     else
  447.     {
  448.       $LN = $#lines;
  449.     }
  450.  
  451.     if ($regdata{'action'} eq 'join' || $regdata{'action'} eq 'leave')
  452.     {
  453.     $tt = $LN . $delimit . 'System' . $delimit . $regdata{'line'} . "\n";
  454.     }
  455.     elsif ($regdata{'action'} eq 'sys' )
  456.     {
  457.     $tt = $LN . $delimit . 'News' . $delimit . $regdata{'line'} . "\n";
  458.     }
  459.     else
  460.     {
  461.       $tt = $LN . $delimit . $regdata{'user'} . $delimit . $regdata{'line'} . "\n";
  462.     }
  463.   }
  464.  
  465.   unless (open (DataFile, ">>" . $chatfile)) 
  466.   {
  467.  #    print ("cant open file3: ", $chatfile, "\n");
  468.      die ("cant open  file\n");
  469.   }
  470. #  print "Result from CGI:" .  $tt;
  471.   print DataFile  $tt;
  472.   close DataFile;
  473.  
  474. # print "output:" . $tt;
  475.   if ($regdata{'action'} eq 'join')
  476.   {
  477.      return;
  478.   }
  479.   print ("###***^^^", "\n");
  480. }
  481.  
  482. if ($regdata{'action'} eq 'getbanner')
  483. {
  484. #print ( "enter getbaner ... in cgi");
  485.   if ($regdata{'action2'} eq 'getgraph')
  486.   {
  487.     $bannerfile = $regdata{'imagedir'} . $regdata{'imageinfo'}; 
  488.     unless (open (DataFile, $bannerfile)) 
  489.     {
  490.      print ("cant open  file :", $bannerfile, "\n");
  491.      die ("cant open  file $bannerfile\n");
  492.     }
  493.   
  494.   
  495.     @input = <DataFile>;
  496.     close(DataFile);
  497.     srand(time ^ $$);
  498.  
  499.     $LastWall = $#input;
  500.     $ttt = $input[int rand $LastWall];
  501.     chop($ttt);
  502.     @List = split (/\^\#\^/, $ttt);
  503.  
  504. print <<"EOP" ;  
  505. <html><body>
  506. <center>
  507. <a href="$List[1]" target = "_blank"><img src="$List[0]" border=0 width=$regdata{'adwidth'} height=$regdata{'adheight'}></a>
  508. </center>
  509. EOP
  510.  
  511. if ($List[2] ne "" && $regdata{'sound'} eq "1")
  512. {
  513. print <<"EOP" ; 
  514. <BGSOUND SRC="$List[2]">
  515. <EMBED SRC="$List[2]" AUTOSTART="TRUE" HIDDEN="TRUE" LOOP="TRUE">
  516. EOP
  517.  
  518. }
  519. }
  520. else
  521. {
  522.  
  523. print <<"EOP" ;  
  524. <html>
  525. <body>
  526. <center>
  527. $regdata{'text'}
  528. <br>
  529. <form>
  530. <input type=button value="Exit" onClick="top.close();">
  531. </form>
  532. </center>
  533. EOP
  534.  
  535. }
  536.  
  537. print <<"EOP" ;  
  538. </body></html>
  539. EOP
  540.  
  541.  
  542.   
  543. }
  544.  
  545. elsif ($regdata{'action'} eq 'check' )
  546. {
  547. #print ( "enter check in cgi");
  548.   $user_exist = 0;
  549.   if (open (DataFile2, $userfile)) 
  550.   {
  551.     $lines = <DataFile2>;
  552.     while ($lines ne "")
  553.     {
  554.       @tt = split(/\^\#\^/,$lines);
  555. #print ($tt[0], "****", $regdata{'user'}, "****");
  556.       if ($tt[0] eq $regdata{'user'})
  557.       {
  558.         $user_exist = 1;
  559.         print "notok";
  560.         close DataFile2;
  561.         return;
  562.       }
  563.  
  564.       $lines = <DataFile2>;
  565.     }
  566.  
  567.     close DataFile2;
  568.   }
  569.  
  570.  
  571.  
  572.     print "ok";
  573.     return;
  574.   
  575. }
  576.  
  577. elsif ($regdata{'action'} eq 'getCallee' )
  578. {
  579. #print ( "enter getCallee ... in cgi");
  580.    unless (open (CallFile, $callfile)) 
  581.    {
  582.    #  print ("cant open file4.5: ", $callfile, "\n");
  583.      &create_file($callfile, "", 'getCallee');
  584.      die ("cant open  file\n");
  585.    }
  586.    @lines = <CallFile>;
  587.    close CallFile;
  588.  
  589.    for ($i=0; $i<=$#lines; $i++)
  590.    {
  591.  
  592.     @tt = split(/\^\#\^/,$lines[$i]);
  593. #print ("tt[0]:", $tt[0], "**\n");
  594. #print ("regdata{'user'}:", $regdata{'user'}, "**\n");
  595. #print ("tt[1]:", $tt[1], "**\n");
  596.  
  597.  
  598.     if ($tt[0] eq $regdata{'user'})
  599.     {
  600.       print ($tt[1], "\n");
  601.     }
  602.   }
  603.   print ("###***^^^", "\n");
  604.   return;
  605.   
  606. }
  607. elsif ($regdata{'action'} eq 'addCall' )
  608. {
  609. #print ( "enter addCall ... in cgi");
  610.    unless (open (CallFile, $callfile)) 
  611.    {
  612.      print ("cant open file4.5: ", $callfile, "\n");
  613.      &create_file($callfile, "", 'addCall');
  614.      die ("cant open  file\n");
  615.    }
  616.    @lines = <CallFile>;
  617.    close CallFile;
  618.  
  619.  
  620.    for ($i=0; $i<=$#lines; $i++)
  621.    {
  622.      chop($lines[$i]);
  623.     if ($lines[$i] eq $regdata{'line'})
  624.     {
  625.       print "###***^^^";
  626.       return;
  627.     }
  628.    }
  629.  
  630.    unless (open (CallFile, ">>" . $callfile)) 
  631.    {
  632.      print ("cant open file5.8: ", $callfile, "\n");
  633.      return;
  634.    }
  635.  
  636.    print CallFile ($regdata{'line'}, "\n");
  637.    close CallFile;
  638.   return;
  639.   
  640. }
  641. elsif ($regdata{'action'} eq 'delCall' )
  642. {
  643. #print ( "enter delCall ... in cgi");
  644.    unless (open (CallFile, $callfile)) 
  645.    {
  646.      &create_file($callfile, "", 'delCall');
  647.      print ("cant open file4.7: ", $callfile, "\n");
  648.      die ("cant open  file\n");
  649.    }
  650.    @lines = <CallFile>;
  651.    close CallFile;
  652.  
  653.  
  654.   
  655.    unless (open (CallFile, ">" . $callfile)) 
  656.    {
  657.      print ("cant open file5.8: ", $callfile, "\n");
  658.      return;
  659.    }
  660.  
  661.    for ($i=0; $i<=$#lines; $i++)
  662.    {
  663.     chop($lines[$i]);
  664.     if ($lines[$i] ne $regdata{'line'})
  665.     {
  666.       print CallFile ($lines[$i], "\n");
  667.     }
  668.    }
  669.  
  670.    
  671.    close CallFile;
  672.   print ("###***^^^", "\n");
  673.   return;
  674.   
  675. }
  676. elsif ($regdata{'action'} eq 'leave' )
  677. {
  678. #print ( "enter leave ... in cgi");
  679.   unless (open (DataFile, $userfile)) 
  680.   {
  681.      print ("cant open file5: ", $userfile, "\n");
  682.      die ("cant open  file\n");
  683.   }
  684.   @lines = <DataFile>;
  685.   close DataFile;
  686.  
  687.   unless (open (DataFile1, ">" . $userfile)) 
  688.   {
  689.      print ("cant open file6: ", $userfile, "\n");
  690.      return;
  691.   }
  692. #print ("#### IN CGI: after open userfile lines=", $#lines, "\n");  
  693.   
  694.   for ($i=0; $i<=$#lines; $i++)
  695.   {
  696.     @tt = split(/\^\#\^/,$lines[$i]);
  697. #print ($tt[0], "***", $regdata{'user'}, "***");
  698.     if ($tt[0] ne $regdata{'user'})
  699.     {
  700.       print DataFile1 ($lines[$i]);
  701.     }
  702.   }
  703.   close DataFile1;
  704.  
  705.  
  706. }
  707.  
  708. elsif ($regdata{'action'} eq 'clear' )
  709. {
  710.   &checkMax(regdata);
  711. }
  712.  
  713. elsif ($regdata{'action'} eq 'email' )
  714. {
  715.   
  716.   &sendmail($regdata{'subject'}, $regdata{'email'}, $regdata{'sender'}, $regdata{'line'});
  717.  
  718. }
  719. elsif ($regdata{'action'} eq 'addpass' )
  720. {
  721.   &checkMax(regdata);
  722. }
  723.  
  724. elsif ($regdata{'action'} eq 'clear' )
  725. {
  726.   &checkMax(regdata);
  727. }
  728. elsif ($regdata{'action'} eq 'additem' )
  729. {
  730.   $TheFile = $datapath . $regdata{'file'};
  731.   if ($regdata{'option'} eq 'unique')
  732.   {
  733.     unless (open (DataFile, $TheFile)) 
  734.     {
  735.       unless (open (DataFile, ">" . $TheFile)) 
  736.       {
  737.         print ("###***^^^", "\n");
  738.         return;
  739.       }
  740.       print DataFile ($regdata{'item'}, "\n");
  741.       close DataFile;
  742.       return;
  743.     }
  744.     @lines = <DataFile>;
  745.     close DataFile;
  746.    
  747.     unless (open (DataFile, ">" . $TheFile)) 
  748.     {
  749.       print ("###***^^^", "\n");
  750.       return;
  751.     }
  752.  
  753.     $exist = 0;
  754.     for ($i=0; $i<=$#lines; $i++)
  755.     {
  756.       print DataFile $lines[$i];
  757.  
  758.       chop($lines[$i]);
  759. print ("***", $lines[$i], "***", $regdata{'item'}, "***");
  760.       if ($lines[$i] eq $regdata{'item'})
  761.       {
  762.         $exist = 1;
  763.       }
  764.     }
  765.     if ($exist == 0)
  766.     {
  767. #print  ($regdata{'item'}, "\n");
  768.       print DataFile ($regdata{'item'}, "\n");
  769.     }
  770.     close DataFile;
  771.     print ("###***^^^", "\n");
  772.  
  773.   }
  774.   else
  775.   {
  776.     unless (open (DataFile, ">>" . $TheFile)) 
  777.     {
  778.       print ("###***^^^", "\n");
  779.       die ("cant open  file\n");
  780.     }
  781.  
  782.     print DataFile ($regdata{'item'}, "\n");
  783.   
  784.     close DataFile;
  785.     print $regdata{'item'};
  786.     print ("###***^^^", "\n");
  787.   }
  788.   print ("###***^^^", "\n");
  789.   return;
  790. }
  791.  
  792. elsif ($regdata{'action'} eq 'checkpairs' )
  793. {
  794. #print ( "enter check in cgi");
  795.   
  796.   $TheFile = $datapath . $regdata{'file'};
  797.   unless (open (DataFile, $TheFile)) 
  798.   {
  799.      print ("###***^^^", "\n");
  800.      die ("cant open  file\n");
  801.   }
  802.   @lines = <DataFile>;
  803.   close DataFile;
  804.  
  805.   if ($regdata{'field0'} eq "")
  806.   {
  807.     print ("###***^^^", "\n");
  808.     return;
  809.   }
  810.  
  811.   for ($i=0; $i<=$#lines; $i++)
  812.   {
  813.     chop($lines[$i]);
  814.     @tt = split(/\^\#\^/,$lines[$i]);
  815.   
  816.     $exist = 1;
  817.      
  818.     $ToExit = 0;
  819.     for ($j=0; $j<10 && $ToExit==0; $j++)
  820.     {
  821.       $ttt = "field$j";
  822.  
  823.       if ($regdata{$ttt} eq "")
  824.       {
  825. #print ("break\n");
  826.          $ToExit=1;
  827.       }
  828.  
  829. #print ("ttt=", $ttt, "  ", $tt[$j], "=", $regdata{$ttt}, "=\n");
  830.  
  831.       if ($ToExit==0 && $tt[$j] ne $regdata{$ttt})
  832.       {
  833.         $exist = 0;
  834.        
  835.         $ToExit=1;
  836.       }
  837.     }
  838. #print ("***\n");
  839.     if ($exist == 1)
  840.     {
  841.       print ("exist");
  842.       return;
  843.     }
  844.  
  845.     
  846.   }
  847.  
  848.  
  849.  
  850.     print ("###***^^^ddd", "\n");
  851.     return;
  852.   
  853. }
  854. elsif ($regdata{'action'} eq 'submit' )
  855. {
  856.    if ($regdata{'line'} eq 'Clear Chat Log')
  857.    {
  858.       
  859.       `rm  Demo_chat.log`;
  860. print "submit==";
  861.    }
  862.    elsif ($regdata{'line'} eq 'Clear User Log')
  863.    {
  864.       `rm \*_user.log\*`;
  865.    }
  866.    elsif ($regdata{'line'} eq 'Remove Sel User')
  867.    {
  868.  
  869.    }
  870.    elsif ($regdata{'line'} eq 'Remove Sel Room')
  871.    {
  872.  
  873.    }
  874. }
  875.  
  876.  
  877.  
  878. sub checkMax
  879. {
  880.   local($regdata) = @_;
  881.   unless (open (DataFile, $chatfile)) 
  882.   {
  883. #     print ("cant open file1: ", $chatfile, "\n");
  884. #     &create_file($chatfile, "");
  885.      die ("cant open  file $chatfile\n");
  886.   }
  887.  
  888.  
  889.   @lines = <DataFile>;
  890.   close DataFile; 
  891.   
  892.   $bb =  0 +  $regdata{'maxline'};
  893.   $bb = $#lines - $bb; 
  894.  
  895.   if ($bb>0)
  896.   {
  897. #print ("hhhh bb=", $bb, "\n");
  898.     `rm $chatfile`;
  899. #print ("lines=", $#lines, "  bb=", $bb, "\n"); 
  900. print ("###***^^^", "\n");
  901.     return;
  902.     
  903.   }
  904. print "###***^^^";
  905. }
  906.  
  907. sub sendmail{
  908.  
  909. local ($title, $receiver, $sender, $content) = @_;
  910.  
  911. open(MAIL, "| /usr/lib/sendmail -t -oi") || die "Can't open mail";
  912.  
  913. print MAIL <<_STOP_;
  914. From: $sender
  915. To: $receiver
  916. Subject: $title
  917. MIME-Version: 1.0
  918. Content-Type: text/plain; charset=us-ascii
  919. Content-Transfer-Encoding: 7bit
  920.  
  921.  
  922.  
  923. $content
  924. _STOP_
  925.  
  926. close(MAIL);
  927. }
  928.  
  929.  
  930.  
  931.  
  932. sub create_file {
  933.   local ($FileName, $TheContent, $desc) = @_;
  934.  
  935.   unless (open (TheFile,
  936.             ">$FileName")) 
  937.   {
  938.      $rr = "cant open File in create file: " . $FileName . " called from " . $desc . "\n";
  939.      print ($rr);
  940.      die ("cant open EnvFile\n");
  941.   }
  942.  
  943.   print TheFile $TheContent;
  944.   close TheFile;
  945.  
  946.   `chmod 777 $FileName`;
  947.  
  948. }
  949.  
  950.  
  951.  
  952.   
  953.  
  954.  
  955. sub ReadParse {
  956.   local (*in) = @_ if @_;
  957.   local ($len, $type, $meth);
  958.  
  959.   # Get several useful env variables
  960.   $type = $ENV{'CONTENT_TYPE'};
  961.   $len = $ENV{'CONTENT_LENGTH'};
  962.   $meth = $ENV{'REQUEST_METHOD'};
  963.  
  964.   if ($len > 9931072) {
  965.       &CgiDie("Request to receive too much data: $len bytes\n");
  966.   }
  967.  
  968.   if ($type eq 'application/x-www-form-urlencoded' || $type eq '' ) {
  969.     local ($key, $val, $i);
  970.  
  971.     # Read in text
  972.     if ($meth eq 'GET') {
  973.       $in = $ENV{'QUERY_STRING'};
  974.     } elsif ($meth eq 'POST') {
  975.         read(STDIN, $in, $len);
  976.     } else {
  977.       &CgiDie("ReadParse: Unknown request method: $meth\n");
  978.     }
  979.  
  980.     @in = split(/[&;]/,$in); 
  981.  
  982.     foreach $i (0 .. $#in) {
  983.       # Convert plus to space
  984.       $in[$i] =~ s/\+/ /g;
  985.  
  986.       # Split into key and value.  
  987.       ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
  988.  
  989.       # Convert %XX from hex numbers to alphanumeric
  990.       $key =~ s/%(..)/pack("c",hex($1))/ge;
  991.       $val =~ s/%(..)/pack("c",hex($1))/ge;
  992.  
  993.       # Associate key and value
  994.       $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
  995.       $in{$key} .= $val;
  996.     }
  997.  
  998.   } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
  999.     # for efficiency, compile multipart code only if needed
  1000. eval <<'END_MULTIPART';
  1001. {
  1002.     local ($buf, $boundary, $head, $blen);
  1003.     local ($bpos, $lpos, $left, $amt, $fn, $ser);
  1004.     local ($bufsize, $maxbound, $writefiles) = 
  1005.       ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
  1006.  
  1007.     ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
  1008.     ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
  1009.     &CgiDie ("Boundary not provided") unless $boundary;
  1010.     $boundary =  "--" . $boundary;
  1011.     $blen = length ($boundary);
  1012.  
  1013.     if ($ENV{'REQUEST_METHOD'} ne 'POST') {
  1014.       &CgiDie("Invalid request method for  multipart/form-data: $meth\n");
  1015.     }
  1016.  
  1017.     if ($writefiles) {
  1018.       local($me);
  1019.       stat ($writefiles);
  1020.       $writefiles = "/tmp" unless  -d _ && -r _ && -w _;
  1021.       ($me) = $0 =~ m#([^/]*)$#;
  1022.       $writefiles = "$writefiles/$me";
  1023.     }
  1024.  
  1025.     $left = $len;
  1026.    PART: # find each part of the multi-part while reading data
  1027.     while (1) {
  1028.       $amt = ($left > $bufsize+$maxbound-length($buf) 
  1029.           ?  $bufsize+$maxbound-length($buf): $left);
  1030.       read(STDIN, $buf, $amt, length($buf));
  1031.       $left -= $amt;
  1032.  
  1033.       $in{$name} .= "\0" if defined $in{$name}; 
  1034.       $in{$name} .= $fn if $fn;
  1035.      BODY: 
  1036.       while (($bpos = index($buf, $boundary)) == -1) {
  1037.         if ($name) {  # if no $name, then it's the prologe -- discard
  1038.           if ($fn) { print FILE substr($buf, 0, $bufsize); }
  1039.           else     { $in{$name} .= substr($buf, 0, $bufsize); }
  1040.         }
  1041.         $buf = substr($buf, $bufsize);
  1042.         $amt = ($left > $bufsize ? $bufsize : $left);
  1043.         read(STDIN, $buf, $amt, $maxbound);  # $maxbound == length($buf);
  1044.         $left -= $amt;
  1045.       }
  1046.       if (defined $name) {  # if no $name, then it's the prologe -- discard
  1047.         if ($fn) { print FILE substr($buf, 0, $bpos-2); }
  1048.         else     { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
  1049.       }
  1050.       close (FILE);
  1051.       last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n";
  1052.       substr($buf, 0, $bpos+$blen+2) = undef;
  1053.       $amt = ($left > $bufsize+$maxbound-length($buf) 
  1054.           ? $bufsize+$maxbound-length($buf) : $left);
  1055.       read(STDIN, $buf, $amt, length($buf));
  1056.       $left -= $amt;
  1057.  
  1058.  
  1059.       undef $head;  undef $fn;
  1060.      HEAD:
  1061.       while (($lpos = index($buf, "\r\n\r\n")) == -1) { 
  1062.         $head .= substr($buf, 0, $bufsize);
  1063.         $buf = substr($buf, $bufsize);
  1064.         $amt = ($left > $bufsize ? $bufsize : $left);
  1065.         read(STDIN, $buf, $amt, $maxbound);  # $maxbound == length($buf);
  1066.         $left -= $amt;
  1067.       }
  1068.       $head .= substr($buf, 0, $lpos+2);
  1069.       push (@in, $head);
  1070.       ($name) = $head =~ /name="([^"]+)"/; #"; 
  1071.       ($name) = $head =~ /name=(\S+)/ unless $name;  
  1072.       if ($writefiles && $head =~ /filename=/) {
  1073.         $ser++;
  1074.     $fn = $writefiles . ".$$.$ser";
  1075.     open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
  1076.       }
  1077.       substr($buf, 0, $lpos+4) = undef;
  1078.     }
  1079.  
  1080. }
  1081. END_MULTIPART
  1082.   } else {
  1083.     &CgiDie("ReadParse: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
  1084.   }
  1085.  
  1086.   return scalar(@in); 
  1087. }
  1088.  
  1089. sub PrintHeader {
  1090.   return "Content-type: text/html\nPragma: no-cache\n\n";
  1091. }
  1092.  
  1093. # CgiDie
  1094. # Identical to CgiError, but also quits with the passed error message.
  1095.  
  1096. sub CgiDie {
  1097.   local (@msg) = @_;
  1098.   &CgiError (@msg);
  1099.   die @msg;
  1100. }
  1101.  
  1102. sub CgiError {
  1103.   local (@msg) = @_;
  1104.   local ($i,$name);
  1105.  
  1106.   if (!@msg) {
  1107.     $name = &MyURL;
  1108.     @msg = ("Error: script $name encountered fatal error");
  1109.   };
  1110.  
  1111.   print &PrintHeader;
  1112.   print "<html><head><title>$msg[0]</title></head>\n";
  1113.   print "<body><h1>$msg[0]</h1>\n";
  1114.   foreach $i (1 .. $#msg) {
  1115.     print "<p>$msg[$i]</p>\n";
  1116.   }
  1117.   print "</body></html>\n";
  1118. }
  1119.  
  1120.  
  1121.