perlでcgiスクリプトを作っている

Sites/index.cgi

  1 #!/usr/bin/perl
  2 
  3 use strict;
  4 use warnings;
  5 
  6 &main();
  7 exit;
  8 
  9 sub main {
 10   if    ($ENV{'HTTP_COOKIE'}) {
 11     if  (&check_ck()) { &private_pg(); }
 12     else              { &basic_pg(-2); }
 13   }
 14   else {
 15     if ($ENV{'REQUEST_METHOD'} eq "POST") {
 16       if  (&check_pw()) { &private_pg(); }
 17       else              { &basic_pg(-1); }
 18     }
 19     else {
 20       &basic_pg(0);
 21     }
 22   }
 23 }
 24 
 25 sub check_ck {
 26   my %in = ();
 27   foreach (split(";",$ENV{'HTTP_COOKIE'})) {
 28     my($key,$val) = split("=");
 29     $in{$key} = $val;
 30   }
 31   if(($in{'CT'} eq "zzz") and ($in{' TC'} eq "aaa")) { return(1); }
 32   else                                               { return(0); }
 33 }
 34 
 35 sub check_pw {
 36   my $post_data = "";
 37   read(STDIN,$post_data,$ENV{'CONTENT_LENGTH'});
 38   my %in = ();
 39   foreach (split("&",$post_data)) {
 40     my($tmp1,$tmp2) = split("=");
 41     $in{$tmp1} = $tmp2;
 42   }
 43   if(($in{'user'} eq "aaa") and ($in{'pass'} eq "bbb")) { return(1); }
 44   else                                                  { return(0); }
 45 }
 46 
 47 sub basic_pg { 
 48   my($flag) = @_; 
 49   my $msg = ""; 
 50   if    ($flag ==  0) { $msg = ""; } 
 51   elsif ($flag == -1) { $msg = "<font class=attention>User/Pass Error"; } 
 52   elsif ($flag == -2) { $msg = $ENV{'HTTP_COOKIE'}; } 
 53   printf STDOUT <<HTML_END; 
 54 Content-type: text/html 
 55  
 56 <html> 
 57 <head> 
 58 </head> 
 59 <body> 
 60 <form action="" method="POST"> 
 61 <table> 
 62  <tr> 
 63   <td>User</td> 
 64   <td><input type=text size="20" name="user" value=""></td> 
 65   <td></td> 
 66  </tr> 
 67  <tr> 
 68   <td>Pass</td> 
 69   <td><input type=password size="20" name="pass" value=""></td> 
 70   <td><input type=submit value="LOGIN" class=button></td> 
 71  </tr> 
 72 </table> 
 73 </form> 
 74 $msg 
 75 </body> 
 76 </html> 
 77 HTML_END 
 78 } 
 79  
 80 sub private_pg { 
 81 printf STDOUT <<HTML_END; 
 82 Set-Cookie: CT=zzz;expires=Tue, 10-May-2030 00:00:00 GMT;path=/; 
 83 Set-Cookie: TC=aaa;expires=Tue, 10-May-2030 00:00:00 GMT;path=/; 
 84 Content-type: text/html 
 85  
 86 <html> 
 87 <head> 
 88 </head> 
 89 <body> 
 90 <a href=./private/>private page</a> 
 91 </body> 
 92 </html> 
 93 HTML_END 
 94 } 
 95  
 96 __END__ 
 97 


Sites/index.cgi/private/index.cgi

 1 #!/usr/bin/perl
  2 
  3 use strict;
  4 use warnings;
  5 
  6 &main();
  7 exit;
  8 
  9 sub main {
 10   if(&ch_ck()) { &basic(); }
 11   else         { &error(); }
 12 }
 13 
 14 sub ch_ck {
 15   if ($ENV{'HTTP_COOKIE'}) { return(1); }
 16   else                     { return(0); }
 17 }
 18 
 19 sub basic {
 20 printf STDOUT <<HTML_END;
 21 Content-type: text/html
 22 
 23 <html>
 24 <head>
 25 </head>
 26 <body>
 27 private
 28 private
 29 private
 30 </body>
 31 </html>
 32 HTML_END
 33 }
 34 
 35 sub error {
 36 printf STDOUT <<HTML_END;
 37 Content-type: text/html
 38 
 39 <html>
 40 <head>
 41 </head>
 42 <body>
 43 error page.
 44 </body>
 45 </html>
 46 HTML_END
 47 }
 48 
 49 
 50 __END__





tail -f /var/log/apache2/error_log

とか、やってエラーログを見て、作ってる。