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