addaccount.cgi 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204
  1. #!/usr/bin/perl
  2. #=========================================================================
  3. # addaccount.cgi ver.1.00
  4. # ladminをラップした、アカウントを作成するCGI。
  5. # ladmin ver.1.04での動作を確認。
  6. #
  7. # ** 設定方法 **
  8. #
  9. # - 下の$ladmin変数にladminへのパスを設定すること。
  10. # - UNIX系OSで使用する場合はladminと共に改行コードを変換すること、また
  11. # ファイル先頭行をperlの正しいパスにすること。例> $ which perl
  12. # - サーバープログラムやブラウザによっては $cgiuri にこのファイルへの
  13. # 完全なURIをセットしなければならない場合もある。
  14. # - perlにパスが通っていない場合は $perl をperlへの正しいパスにすること。
  15. # - 他は普通のCGIと同じです。(実行権やcgi-binフォルダなど)
  16. #
  17. # ** その他 **
  18. # addaccount.cgi をブラウザで開くとサンプルHTML(そのまま使えます)が
  19. # 開きます。また、このcgiはブラウザから送られるAccept-Languageが
  20. # jaで始まっていればメッセージの一部を日本語に変換します。
  21. # (IEならインターネットオプションの言語設定で一番上に日本語を置く)
  22. # それ以外の場合は英語のまま出力します。
  23. #-------------------------------------------------------------------------
  24. my($ladmin) = "../ladmin"; # ladminのパス(おそらく変更が必要)
  25. my($cgiuri) = "./addaccount.cgi"; # このファイルのURI
  26. my($perl) = "perl"; # perlのコマンド名
  27. #--------------------------- 設定ここまで --------------------------------
  28. use strict;
  29. use CGI;
  30. my($cgi)= new CGI;
  31. my(%langconv)=(
  32. 'Athena login-server administration tool.*' => '',
  33. 'logged on.*' => '',
  34. );
  35. # ----- 日本語環境なら変換テーブルをセット -----
  36. if($ENV{'HTTP_ACCEPT_LANGUAGE'}=~/^ja/){
  37. my(%tmp)=(
  38. 'Account \[(.+)\] is successfully created.*'
  39. => 'アカウント "$1" を作成しました.',
  40. 'Account \[(.+)\] creation failed\. same account exists.*'
  41. => 'アカウント "$1" は既に存在します.',
  42. 'Illeagal charactor found in UserID.*'
  43. => 'IDの中に不正な文字があります.',
  44. 'Illeagal charactor found in Password.*'
  45. => 'Passwordの中に不正な文字があります.',
  46. 'input UserID 4-24 bytes.'
  47. => 'IDは半角4~24文字で入力してください.',
  48. 'input Password 4-24 bytes.'
  49. => 'Passwordは半角4~24文字で入力してください.',
  50. 'Illeagal gender.*'
  51. => '性別がおかしいです.',
  52. 'Cant connect to login server.*'
  53. => 'ログインサーバーに接続できません.',
  54. 'login error.*'
  55. => 'ログインサーバーへの管理者権限ログインに失敗しました',
  56. "Can't execute ladmin.*"
  57. => 'ladminの実行に失敗しました',
  58. 'UserID "(.+)" is already used.*'
  59. => 'ID "$1" は既に使用されています.',
  60. 'You can use UserID \"(.+)\".*'
  61. => 'ID "$1" は使用可能です.',
  62. 'account making' =>'アカウント作成',
  63. '\>UserID' =>'>ID',
  64. '\>Password' =>'>パスワード',
  65. '\>Gender' =>'>性別',
  66. '\>Male' =>'>男性',
  67. '\>Female' =>'>女性',
  68. '\"Make Account\"' =>'"アカウント作成"',
  69. '\"Check UserID\"' =>'"IDのチェック"',
  70. );
  71. map { $langconv{$_}=$tmp{$_}; } keys (%tmp);
  72. }
  73. # ----- 追加 -----
  74. if( $cgi->param("addaccount") ){
  75. my($userid)= $cgi->param("userid");
  76. my($passwd)= $cgi->param("passwd");
  77. my($gender)= lc(substr($cgi->param("gender"),0,1));
  78. if(length($userid)<4 || length($userid)>24){
  79. HttpError("input UserID 4-24 bytes.");
  80. }
  81. if(length($passwd)<4 || length($passwd)>24){
  82. HttpError("input Password 4-24 bytes.");
  83. }
  84. if($userid=~/[^0-9A-Za-z\@\_\-\']/){
  85. HttpError("Illeagal charactor found in UserID.");
  86. }
  87. if($passwd=~/[\x00-\x1f\x80-\xff\']/){
  88. HttpError("Illeagal charactor found in Password.");
  89. }
  90. if($gender!~/[mf]/){
  91. HttpError("Gender error.");
  92. }
  93. open PIPE,"$perl $ladmin --add $userid $gender $passwd |"
  94. or HttpError("Can't execute ladmin.");
  95. my(@msg)=<PIPE>;
  96. close PIPE;
  97. HttpMsg(@msg);
  98. }
  99. # ----- 存在チェック -----
  100. elsif( $cgi->param("check") ){
  101. my($userid)= $cgi->param("userid");
  102. if(length($userid)<4 || length($userid)>24){
  103. HttpError("input UserID 4-24 bytes.");
  104. }
  105. if($userid=~/[^0-9A-Za-z\@\_\-\']/){
  106. HttpError("Illeagal charactor found in UserID.");
  107. }
  108. open PIPE,"$perl $ladmin --search --regex \\b$userid\\b |"
  109. or HttpError("Can't execute ladmin.");
  110. my(@msg)=<PIPE>;
  111. close PIPE;
  112. if(scalar(@msg)==6 && (split /[\s\0]+/,substr($msg[4],11,24))[0] eq $userid){
  113. HttpMsg("NG : UserID \"$userid\" is already used.");
  114. }elsif(scalar(@msg)==5){
  115. HttpMsg("OK : You can use UserID \"$userid\"");
  116. }
  117. HttpError("ladmin error ?\n---output---\n",@msg);
  118. }
  119. # ----- フォーム -----
  120. else{
  121. print LangConv( <<"EOM" );
  122. Content-type: text/html\n
  123. <html>
  124. <head>
  125. <title>Athena account making cgi</title>
  126. </head>
  127. <body>
  128. <h1>Athena account making cgi</h1>
  129. <form action="$cgiuri" method="post">
  130. <table border=2>
  131. <tr>
  132. <th>UserID</th>
  133. <td><input name="userid" size=24 maxlength=24></td>
  134. </tr>
  135. <tr>
  136. <th>Password</th>
  137. <td><input name="passwd" size=24 maxlength=24 type="password"></td>
  138. </tr>
  139. <tr>
  140. <th>Gender</th>
  141. <td>
  142. <input type="radio" name="gender" value="male">Male
  143. <input type="radio" name="gender" value="female">Female
  144. </td>
  145. </tr>
  146. <tr>
  147. <td colspan=2>
  148. <input type="submit" name="addaccount" value="Make Account">
  149. <input type="submit" name="check" value="Check UserID">
  150. </td>
  151. </tr>
  152. </table>
  153. </form>
  154. </body>
  155. </html>
  156. EOM
  157. exit;
  158. }
  159. sub LangConv {
  160. my(@lst)= @_;
  161. my($a,$b,@out)=();
  162. foreach $a(@lst){
  163. foreach $b(keys %langconv){
  164. $a=~s/$b/$langconv{$b}/g;
  165. my($rep1)=$1;
  166. $a=~s/\$1/$rep1/g;
  167. }
  168. push @out,$a;
  169. }
  170. return @out;
  171. }
  172. sub HttpMsg {
  173. my($msg)=join("", LangConv(@_));
  174. $msg=~s/\n/<br>\n/g;
  175. print LangConv("Content-type: text/html\n\n"),$msg;
  176. exit;
  177. }
  178. sub HttpError {
  179. my($msg)=join("", LangConv(@_));
  180. $msg=~s/\n/<br>\n/g;
  181. print LangConv("Content-type: text/html\n\n"),$msg;
  182. exit;
  183. }