d9898ee8 |
1 | #! @PERL@ |
d9898ee8 |
2 | # |
3 | # Copyright 1998 - 1999 Double Precision, Inc. See COPYING for |
4 | # distribution information. |
5 | |
6 | use Fcntl ':flock'; |
7 | |
8 | $prefix="@prefix@"; |
9 | $exec_prefix="@exec_prefix@"; |
10 | $userdb="@userdb@"; |
11 | |
12 | eval { |
13 | die "SYMLINK\n" if -l $userdb; |
14 | }; |
15 | |
16 | die "ERROR: Wrong userdb command.\n ($userdb is a symbolic link)\n" |
17 | if $@ eq "SYMLINK\n"; |
18 | |
19 | sub usage { |
20 | print "Usage: $0 [path/.../ | -f file ]name set field=value field=value...\n"; |
21 | print " $0 [path/.../ | -f file ]name unset field field...\n"; |
22 | print " $0 [path/.../ | -f file ]name del\n"; |
23 | print " $0 -show [path/... | -f file ] [name]\n"; |
24 | exit 1; |
25 | } |
26 | |
27 | $name=shift @ARGV; |
28 | $doshow=0; |
29 | |
30 | if ($name eq "-show") |
31 | { |
32 | $doshow=1; |
33 | $name=shift @ARGV; |
34 | } |
35 | |
36 | if ($name eq "-f") |
37 | { |
38 | $userdb=shift @ARGV; |
39 | $name=shift @ARGV; |
40 | } |
41 | elsif ( $name =~ /^(.*)\/([^\/]*)$/ ) |
42 | { |
43 | $userdb="$userdb/$1"; |
44 | $name=$2; |
45 | } |
46 | |
47 | |
48 | if ($doshow) |
49 | { |
50 | &usage unless $userdb =~ /./; |
51 | } |
52 | else |
53 | { |
54 | $verb=shift @ARGV; |
55 | |
56 | &usage unless $verb =~ /./ && $name =~ /./ && $userdb =~ /./; |
57 | } |
58 | |
59 | while (defined ($link= &safe_readlink($userdb))) |
60 | { |
61 | $userdb .= "/"; |
62 | $userdb = "" if $link =~ /^\//; |
63 | $userdb .= $link; |
64 | } |
65 | |
66 | $tmpuserdb= $userdb =~ /^(.*)\/([^\/]*)$/ ? "$1/.tmp.$2":".tmp.$userdb"; |
67 | $lockuserdb= $userdb =~ /^(.*)\/([^\/]*)$/ ? "$1/.lock.$2":".lock.$userdb"; |
68 | |
69 | if ( $doshow && ! defined $name) |
70 | { |
71 | } |
72 | else |
73 | { |
74 | die "Invalid name: $name\n" |
dd184caf |
75 | unless $name =~ /^[\@a-zA-Z0-9\.\-\_\:\+]+$/; |
d9898ee8 |
76 | } |
77 | |
78 | grep( (/[\|\n]/ && die "Invalid field or value.\n"), @ARGV); |
79 | |
80 | umask(066); |
81 | |
82 | open(LOCK, ">$lockuserdb") or die "Can't open $lockuserdb: $!"; |
83 | flock(LOCK,LOCK_EX) || die "Can't lock $lockuserdb: $!"; |
84 | |
85 | if ( $doshow ) |
86 | { |
87 | if (open (OLDFILE, $userdb)) |
88 | { |
89 | stat(OLDFILE); |
90 | die "$userdb: not a file.\n" unless -f _; |
91 | |
92 | while ( defined($_=<OLDFILE>) ) |
93 | { |
94 | chop if /\n$/; |
95 | next if /^#/; |
96 | next unless /^([^\t]+)(\t(.*))?$/; |
97 | ($addr,$vals)=($1,$3); |
98 | if (defined $name) |
99 | { |
100 | if ($name eq $addr) |
101 | { |
102 | $vals =~ s/\|/\n/g; |
103 | print "$vals\n"; |
104 | last; |
105 | } |
106 | } |
107 | else |
108 | { |
109 | print "$addr\n"; |
110 | } |
111 | } |
112 | } |
113 | close (OLDFILE); |
114 | } |
115 | elsif ( $verb eq "set" ) |
116 | { |
117 | $isatty=1; |
118 | |
119 | eval { |
120 | $isatty=0 unless -t STDIN; |
121 | } ; |
122 | |
123 | &doadd; |
124 | $mode= (stat $userdb)[2]; |
125 | chmod ($mode & 0777,$tmpuserdb ) if defined $mode; |
126 | rename $tmpuserdb,$userdb; |
127 | } |
128 | elsif ( $verb eq "unset" ) |
129 | { |
130 | if ($#ARGV >= 0 && &dodel) |
131 | { |
132 | $mode= (stat $userdb)[2]; |
133 | chmod ($mode & 0777 ,$tmpuserdb) if defined $mode; |
134 | rename ($tmpuserdb,$userdb) |
135 | } |
136 | } |
137 | elsif ( $verb eq "del" ) |
138 | { |
139 | &usage unless $#ARGV < 0; |
140 | if (&dodel) |
141 | { |
142 | $mode= (stat $userdb)[2]; |
143 | chmod ($mode & 0777 ,$tmpuserdb) if defined $mode; |
144 | rename ($tmpuserdb,$userdb) |
145 | } |
146 | } |
147 | else |
148 | { |
149 | &usage; |
150 | } |
151 | exit 0; |
152 | |
153 | sub doadd { |
154 | my (%FIELDS); |
155 | my ($key, $in); |
156 | |
157 | foreach $key (@ARGV) |
158 | { |
159 | next if $key =~ /=/; |
160 | print "$name.$key: " if $isatty; |
161 | exit 1 unless defined ($in=<STDIN>); |
162 | chop $in if $in =~ /\n$/; |
163 | die "Invalid value.\n" if $in =~ /[\|\n]/; |
164 | $key = "$key=$in"; |
165 | } |
166 | |
167 | open (NEWFILE, ">$tmpuserdb") || die "$!\n"; |
168 | if (open (OLDFILE, $userdb)) |
169 | { |
170 | stat(OLDFILE); |
171 | die "$userdb: not a file.\n" unless -f _; |
172 | while ( defined($_=<OLDFILE>) ) |
173 | { |
174 | chop if /\n$/; |
175 | if ( /^([^\t]+)(\t(.*))?$/ && ($1 eq $name)) |
176 | { |
177 | grep( (/^([^=]*)(=.*)?$/, |
178 | $FIELDS{$1}="$2"), split(/\|/, $3)); |
179 | while ( defined ($key=shift @ARGV)) |
180 | { |
181 | $key =~ /^([^=]*)(=.*)?$/; |
182 | $FIELDS{$1}="$2"; |
183 | } |
184 | $name="$name\t"; |
185 | grep ( $name="$name$_$FIELDS{$_}|", |
186 | keys %FIELDS); |
187 | chop $name; |
188 | print NEWFILE "$name\n" || die "$!\n"; |
189 | while (<OLDFILE>) |
190 | { |
191 | print NEWFILE || die "$!\n"; |
192 | } |
193 | close (OLDFILE); |
194 | close (NEWFILE) || die "$!\n"; |
195 | return; |
196 | } |
197 | print NEWFILE "$_\n" || die "$!\n"; |
198 | } |
199 | close (OLDFILE); |
200 | } |
201 | |
202 | $name="$name\t"; |
203 | grep ( $name="$name$_|", @ARGV ); |
204 | chop $name; |
205 | print NEWFILE "$name\n" || die "$!\n"; |
206 | close (NEWFILE) || die "$!\n"; |
207 | } |
208 | |
209 | sub dodel { |
210 | my (%FIELDS); |
211 | |
212 | open (NEWFILE, ">$tmpuserdb") || die "$!\n"; |
213 | if (open (OLDFILE, $userdb)) |
214 | { |
215 | stat(OLDFILE); |
216 | die "$userdb: not a file.\n" unless -f _; |
217 | while ( defined($_=<OLDFILE>) ) |
218 | { |
219 | chop if /\n$/; |
220 | if ( /^([^\t]+)(\t(.*))?$/ && ($1 eq $name)) |
221 | { |
222 | if ($#ARGV >= 0) |
223 | { |
224 | grep( (/^([^=]*)(=.*)?$/, |
225 | $FIELDS{$1}=$2), |
226 | split(/\|/, $3)); |
227 | grep( delete $FIELDS{$_}, @ARGV); |
228 | |
229 | $name="$name\t"; |
230 | grep ( $name="$name$_$FIELDS{$_}|", |
231 | keys %FIELDS); |
232 | chop $name; |
233 | $name="$name\n"; |
234 | print NEWFILE "$name" || die "$!\n"; |
235 | } |
236 | while (<OLDFILE>) |
237 | { |
238 | print NEWFILE || die "$!\n"; |
239 | } |
240 | close (OLDFILE); |
241 | close (NEWFILE) || die "$!\n"; |
242 | return (1); |
243 | } |
244 | print NEWFILE "$_\n" || die "$!\n"; |
245 | } |
246 | close (OLDFILE); |
247 | } |
248 | unlink "$tmpuserdb"; |
249 | return (0); |
250 | } |
251 | |
252 | sub safe_readlink { |
253 | my ($l)=@_; |
254 | my ($err,$link); |
255 | |
256 | eval { |
257 | |
258 | $link=readlink($l); |
259 | } ; |
260 | |
261 | $link=undef if $@; |
262 | return $link; |
263 | } |