root/tools/cgi/addaccount.cgi @ 23

Revision 1, 5.7 kB (checked in by jinshiro, 17 years ago)
Line 
1#!/usr/bin/perl
2
3#=========================================================================
4# addaccount.cgi  ver.1.00
5#       ladmin‚ðƒ‰ƒbƒv‚µ‚œAƒAƒJƒEƒ“ƒg‚ðì¬‚·‚éCGIB
6#       ladmin ver.1.04‚Å‚Ì“®ì‚ðŠm”FB
7#
8# ** Ý’è•û–@ **
9#
10# - ‰º‚Ì$ladmin•Ï”‚Éladmin‚ւ̃pƒX‚ðÝ’è‚·‚邱‚ƁB
11# - UNIXŒnOS‚ÅŽg—p‚·‚éê‡‚Íladmin‚Æ‹€‚ɉüsƒR[ƒh‚ð•ÏŠ·‚·‚邱‚ƁA‚Ü‚œ
12#   ƒtƒ@ƒCƒ‹æ“ªs‚ðperl‚̐³‚µ‚¢ƒpƒX‚É‚·‚邱‚ƁB—á> $ which perl
13# - ƒT[ƒo[ƒvƒƒOƒ‰ƒ€‚âƒuƒ‰ƒEƒU‚É‚æ‚Á‚Ä‚Í $cgiuri ‚É‚±‚̃tƒ@ƒCƒ‹‚Ö‚Ì
14#   Š®‘S‚ÈURI‚ðƒZƒbƒg‚µ‚È‚¯‚ê‚΂Ȃç‚È‚¢ê‡‚à‚ ‚éB
15# - perl‚ɃpƒX‚ª’Ê‚Á‚Ä‚¢‚È‚¢ê‡‚Í $perl ‚ðperl‚ւ̐³‚µ‚¢ƒpƒX‚É‚·‚邱‚ƁB
16# - ‘Œ‚Í•’Ê‚ÌCGI‚Æ“¯‚¶‚Å‚·BiŽÀsŒ ‚âcgi-binƒtƒHƒ‹ƒ_‚Ȃǁj
17#
18# ** ‚»‚Ì‘Œ **
19#   addaccount.cgi ‚ðƒuƒ‰ƒEƒU‚ÅŠJ‚­‚ƃTƒ“ƒvƒ‹HTMLi‚»‚Ì‚Ü‚ÜŽg‚Š‚Ü‚·j‚ª
20#   ŠJ‚«‚Ü‚·B‚Ü‚œA‚±‚Ìcgi‚̓uƒ‰ƒEƒU‚©‚ç‘—‚ç‚ê‚éAccept-Language‚ª
21#   ja‚ÅŽn‚Ü‚Á‚Ä‚¢‚ê‚΃ƒbƒZ[ƒW‚̈ꕔ‚ð“ú–{Œê‚É•ÏŠ·‚µ‚Ü‚·B
22#   (IE‚È‚çƒCƒ“ƒ^[ƒlƒbƒgƒIƒvƒVƒ‡ƒ“‚ÌŒŸŒêÝ’è‚ňê”ԏã‚É“ú–{Œê‚ð’u‚­)
23#       ‚»‚êˆÈŠO‚̏ꍇ‚͉pŒê‚̂܂܏o—Í‚µ‚Ü‚·B
24#-------------------------------------------------------------------------
25
26my($ladmin)     = "../ladmin";                  # ladmin‚̃pƒX(‚š‚»‚ç‚­•ÏX‚ª•K—v)
27
28my($cgiuri)     = "./addaccount.cgi";   # ‚±‚̃tƒ@ƒCƒ‹‚ÌURI
29my($perl)       = "perl";                               # perl‚̃Rƒ}ƒ“ƒh–Œ
30
31
32
33#--------------------------- Ý’肱‚±‚Ü‚Å --------------------------------
34
35
36
37
38
39
40use strict;
41use CGI;
42
43my($cgi)= new CGI;
44my(%langconv)=(
45        'Athena login-server administration tool.*' => '',
46        'logged on.*' => '',
47);
48
49# ----- “ú–{ŒêŠÂ‹«‚È‚ç•ÏŠ·ƒe[ƒuƒ‹‚ðƒZƒbƒg -----
50if($ENV{'HTTP_ACCEPT_LANGUAGE'}=~/^ja/){
51        my(%tmp)=(
52                'Account \[(.+)\] is successfully created.*'
53                        => 'ƒAƒJƒEƒ“ƒg "$1" ‚ðì¬‚µ‚Ü‚µ‚œ.',
54                'Account \[(.+)\] creation failed\. same account exists.*'
55                        => 'ƒAƒJƒEƒ“ƒg "$1" ‚ÍŠù‚É‘¶Ý‚µ‚Ü‚·.',
56                'Illeagal charactor found in UserID.*'
57                        => 'ID‚Ì’†‚É•s³‚È•¶Žš‚ª‚ ‚è‚Ü‚·.',
58                'Illeagal charactor found in Password.*'
59                        => 'Password‚Ì’†‚É•s³‚È•¶Žš‚ª‚ ‚è‚Ü‚·.',
60                'input UserID 4-24 bytes.'
61                        => 'ID‚Í”ŒŠp4`24•¶Žš‚Å“ü—Í‚µ‚Ä‚­‚Ÿ‚³‚¢.',
62                'input Password 4-24 bytes.'
63                        => 'Password‚Í”ŒŠp4`24•¶Žš‚Å“ü—Í‚µ‚Ä‚­‚Ÿ‚³‚¢.',
64                'Illeagal gender.*'
65                        => '«•Ê‚ª‚š‚©‚µ‚¢‚Å‚·.',
66                'Cant connect to login server.*'
67                        => 'ƒƒOƒCƒ“ƒT[ƒo[‚ɐڑ±‚Å‚«‚Ü‚¹‚ñ.',
68                'login error.*'
69                        => 'ƒƒOƒCƒ“ƒT[ƒo[‚Ö‚ÌŠÇ—ŽÒŒ ŒÀƒƒOƒCƒ“‚ÉŽž”s‚µ‚Ü‚µ‚œ',
70                "Can't execute ladmin.*"
71                        => 'ladmin‚ÌŽÀs‚ÉŽž”s‚µ‚Ü‚µ‚œ',
72                'UserID "(.+)" is already used.*'
73                        => 'ID "$1" ‚ÍŠù‚ÉŽg—p‚³‚ê‚Ä‚¢‚Ü‚·.',
74                'You can use UserID \"(.+)\".*'
75                        => 'ID "$1" ‚ÍŽg—p‰Â”\‚Å‚·.',
76               
77                'account making'        =>'ƒAƒJƒEƒ“ƒgì¬',
78                '\>UserID'                      =>'>‚h‚c',
79                '\>Password'            =>'>ƒpƒXƒ[ƒh',
80                '\>Gender'                      =>'>«•Ê',
81                '\>Male'                        =>'>’j«',
82                '\>Female'                      =>'>—«',
83                '\"Make Account\"'      =>'"ƒAƒJƒEƒ“ƒgì¬"',
84                '\"Check UserID\"'      =>'"ID‚̃`ƒFƒbƒN"',
85        );
86        map { $langconv{$_}=$tmp{$_}; } keys (%tmp);
87}
88
89# ----- ’ljÁ -----
90if( $cgi->param("addaccount") ){
91        my($userid)= $cgi->param("userid");
92        my($passwd)= $cgi->param("passwd");
93        my($gender)= lc(substr($cgi->param("gender"),0,1));
94        if(length($userid)<4 || length($userid)>24){
95                HttpError("input UserID 4-24 bytes.");
96        }
97        if(length($passwd)<4 || length($passwd)>24){
98                HttpError("input Password 4-24 bytes.");
99        }
100        if($userid=~/[^0-9A-Za-z\@\_\-\']/){
101                HttpError("Illeagal charactor found in UserID.");
102        }
103        if($passwd=~/[\x00-\x1f\x80-\xff\']/){
104                HttpError("Illeagal charactor found in Password.");
105        }
106        if($gender!~/[mf]/){
107                HttpError("Gender error.");
108        }
109        open PIPE,"$perl $ladmin --add $userid $gender $passwd |"
110                or HttpError("Can't execute ladmin.");
111        my(@msg)=<PIPE>;
112        close PIPE;
113        HttpMsg(@msg);
114}
115# ----- ‘¶Ýƒ`ƒFƒbƒN -----
116elsif( $cgi->param("check") ){
117        my($userid)= $cgi->param("userid");
118        if(length($userid)<4 || length($userid)>24){
119                HttpError("input UserID 4-24 bytes.");
120        }
121        if($userid=~/[^0-9A-Za-z\@\_\-\']/){
122                HttpError("Illeagal charactor found in UserID.");
123        }
124        open PIPE,"$perl $ladmin --search --regex \\b$userid\\b |"
125                or HttpError("Can't execute ladmin.");
126        my(@msg)=<PIPE>;
127        close PIPE;
128        if(scalar(@msg)==6 && (split /[\s\0]+/,substr($msg[4],11,24))[0] eq $userid){
129                HttpMsg("NG : UserID \"$userid\" is already used.");
130        }elsif(scalar(@msg)==5){
131                HttpMsg("OK : You can use UserID \"$userid\"");
132        }
133        HttpError("ladmin error ?\n---output---\n",@msg);
134}
135
136# ----- ƒtƒH[ƒ€ -----
137else{
138        print LangConv( <<"EOM" );
139Content-type: text/html\n
140<html>
141 <head>
142  <title>Athena account making cgi</title>
143 </head>
144 <body>
145  <h1>Athena account making cgi</h1>
146  <form action="$cgiuri" method="post">
147   <table border=2>
148    <tr>
149     <th>UserID</th>
150     <td><input name="userid" size=24 maxlength=24></td>
151    </tr>
152    <tr>
153     <th>Password</th>
154     <td><input name="passwd" size=24 maxlength=24 type="password"></td>
155    </tr>
156    <tr>
157     <th>Gender</th>
158     <td>
159      <input type="radio" name="gender" value="male">Male
160      <input type="radio" name="gender" value="female">Female
161     </td>
162    </tr>
163    <tr>
164     <td colspan=2>
165      <input type="submit" name="addaccount" value="Make Account">
166      <input type="submit" name="check" value="Check UserID">
167     </td>
168    </tr>
169   </table>
170  </form>
171 </body>
172</html>
173EOM
174        exit;
175}
176
177sub LangConv {
178        my(@lst)= @_;
179        my($a,$b,@out)=();
180        foreach $a(@lst){
181                foreach $b(keys %langconv){
182                        $a=~s/$b/$langconv{$b}/g;
183                        my($rep1)=$1;
184                        $a=~s/\$1/$rep1/g;
185                }
186                push @out,$a;
187        }
188        return @out;
189}
190
191sub HttpMsg {
192        my($msg)=join("", LangConv(@_));
193        $msg=~s/\n/<br>\n/g;
194        print LangConv("Content-type: text/html\n\n"),$msg;
195        exit;
196}
197
198sub HttpError {
199        my($msg)=join("", LangConv(@_));
200        $msg=~s/\n/<br>\n/g;
201        print LangConv("Content-type: text/html\n\n"),$msg;
202        exit;
203}
204
Note: See TracBrowser for help on using the browser.