]> git.defcon.no Git - hermes/blob - guc-clients/sipalias
First stab at a naive permissions-tool
[hermes] / guc-clients / sipalias
1 #!/usr/bin/perl
2 use strict;
3
4 use Data::Dumper;
5
6 #TODO: Add support for assigning phone number
7 #TODO: Add support for overriding default domain ...
8
9 use Getopt::Long;
10 use Net::LDAP;
11 use Net::LDAP::Control::Paged;
12 use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED );
13 use LWP;
14 use JSON;
15 use AppConfig;
16 use Text::Iconv;
17
18 my $api_key;
19
20 my $help;
21 my $username;
22 my $alias;
23 my $number;
24 my $remove = 0;
25 my $dryrun = 0;
26 my $configfile = undef;
27 my ($g_ua, $session, $api_key, $auth_key, $data, $domain);
28
29 my $config = AppConfig->new({ CREATE => 1 });
30
31 $config->define("api_url=s");
32 $config->define("api_keyfile=s");
33
34 $config->define("default_domain=s");
35 $config->default_domain("hig.no");
36
37 $config->define("numbers_local_prefix=s");
38 $config->define("numbers_local_series=s");
39 $config->define("numbers_countrycode=s");
40
41 foreach (
42 "/usr/local/etc/hermes/hermes_config",
43 "/usr/local/etc/hermes/config",
44 "/etc/hermes/config",
45 $ENV{"HOME"} . "/.hermes/config",
46 $ENV{"HOME"} . "/.hermes_config",
47 ) { $configfile = $_ if ( -f $_ ); }
48
49 GetOptions(
50 "help" => \$help,
51 "configfile=s" => \$configfile,
52 "username=s" => \$username,
53 "alias=s" => \$alias,
54 "number=s" => \$number,
55 "remove" => \$remove,
56 "dryrun" => \$dryrun,
57
58 );
59
60 if (
61 (not $username) ||
62 (not $configfile) ||
63 ((not $alias) && (not $number)) ||
64 (($alias) && ($number)) ||
65 (( $configfile ) && ( not -f $configfile ))
66 )
67 {
68 $help = 1;
69 }
70
71 $config->file( $configfile );
72
73 if ( ( not $config->api_url ) ||
74 ( not $config->api_keyfile ) ||
75 ( $config->api_keyfile && not -f $config->api_keyfile )
76 )
77 {
78 $help = 1;
79 }
80
81 if ( $help ) {
82 print <<END_HELP;
83 Verify that the following options are set:
84 --username=s|--user|-u
85 either --alias=s|-a
86 or --number=s|-n
87 --remove
88 --dryrun
89 --csv
90
91 Verify the contents of the configuration file.
92 Verify that the key-file exists.
93 END_HELP
94 exit; }
95
96 open KEY, "<" . $config->api_keyfile;
97 chomp( $api_key = <KEY> );
98 close KEY;
99
100 if ( not $username =~ m/\w+/ )
101 { print "Illegal username\n"; exit; }
102
103 $g_ua = LWP::UserAgent->new;
104 $g_ua->cookie_jar({}); # In-memory jar, look at HTTP::Cookies for persistant
105
106 login_apikey();
107
108 # First: fetch a supported domain from the API...
109 $data = exec_apinode("domain/list", undef);
110 if ( $data->{'response'} eq 'ok' )
111 {
112 $domain = $data->{'list'}[0];
113 }
114 else
115 {
116 printf("Unable to get domain name. Aborting\n");
117 logout();
118 exit;
119 }
120
121 if ( $username =~ /@/ )
122 {
123 ( $username, $domain ) = split /@/, $username;
124 }
125
126 $data = exec_apinode("user/available", { 'username' => $username, 'domain' => $domain });
127 if ( $data->{'response'} eq 'ok' )
128 {
129 printf("Username is not registered.\n");
130 logout();
131 exit;
132 }
133
134 if ( not $data->{'cause'} eq 'exists' )
135 {
136 printf("Username lookup failed, cause: %s.\n", $data->{'cause'});
137 logout();
138 exit;
139 }
140 undef $data;
141
142 my $use_alias;
143
144 if ( $number )
145 {
146
147 if ( $number =~ m/^+.\d+$/)
148 {
149 # Prefix country-code unless number includes ....
150 $use_alias = $config->numbers_countrycode unless $number =~ m/^\+\d\d/;
151
152 # Add local prefix if local-series regex matches.
153 my $t = $config->numbers_local_series;
154 $use_alias .= $config->numbers_local_prefix if $number =~ m/^$t$/;
155
156 # Add supplied number
157 $use_alias .= $number;
158
159 # Finally, tack on domain to complete E164 SIP address:
160 $use_alias .= "@" . $domain;
161 }
162 else
163 {
164 printf("Failed number format test. Check input and retry\n");
165 logout();
166 exit;
167 }
168 }
169 elsif ( $alias )
170 {
171 # Add domain to given alias, unless it seems to contain one..
172 $alias .= "@" . $domain if not $alias =~ m/\@\w+/;
173 print $alias . "\n";
174
175 # A fairly naive email-format address checker...
176 if ( $alias =~ m/^([\w-_\+]+\.)*[\w-_\+]+\@([\w-_\+]+\.)+\w+$/ )
177 {
178 $use_alias = $alias;
179 }
180 else
181 {
182 printf("Failed alias format test. Check input and retry\n");
183 logout();
184 exit;
185 }
186 }
187 printf("Alias after expanding options: %s\n", $use_alias);
188
189 # URL-encode any plus-signs in the address...
190 #$use_alias =~ s/\+/\%2B/g;
191 # Seems to not be needed, am I doing this somewhere else?
192
193 undef $data;
194 # run alias/list with alias=$use_alias, expect an empty list
195 $data = exec_apinode("alias/list", { 'alias' => $use_alias });
196 if ( not $data->{'response'} eq 'ok' )
197 {
198 printf("Something failed trying to see if alias is in use...\n");
199 logout();
200 exit;
201 }
202 my $t = $data->{'aliases'}; my @aliases = @$t;
203
204 # End of common code, rest is different for add/remove
205 if ( not $remove )
206 {
207 # if list is non-empty, fail/abort, alias already taken
208 if ( not $#aliases == -1 )
209 {
210 printf("Given alias/number already exists, unable to proceed\n");
211 logout();
212 exit;
213 }
214 # run alias/add with $username@$domain as destination and $use_alias as alias
215 undef $data;
216 $data = exec_apinode("alias/add", { 'alias' => $use_alias, 'destination' => $username . "@" . $domain });
217 # fail unless OK is returned.
218 if ( not $data->{'response'} eq 'ok' )
219 {
220 printf("Unable to add alias, Hermes response is: %s\n", $data->{'cause'});
221 logout();
222 exit;
223 }
224 printf("Alias after expansion '%s' added to user '%s'\n", $use_alias, $username . "@" . $domain );
225 }
226 else
227 {
228 if ( not $#aliases == 0 )
229 {
230 printf("Search for alias did not return correct number of results (%d != 1)\n", ($#aliases+1));
231 logout();
232 exit;
233 }
234 if ( not $aliases[0]->{'alias'} eq $use_alias )
235 {
236 printf("Not a match on alias: %s != %s\n", $aliases[0]->{'alias'}, $use_alias );
237 logout();
238 exit;
239 }
240
241 if ( not $aliases[0]->{'destination'} eq $username . "@" . $domain )
242 {
243 printf("Not a match on destination: %s != %s\n",
244 $aliases[0]->{'destination'}, $username . "@" . $domain
245 );
246 logout();
247 exit;
248 }
249 undef $data;
250 $data = exec_apinode("alias/remove", { 'alias' => $use_alias });
251 # fail unless OK is returned.
252 if ( not $data->{'response'} eq 'ok' )
253 {
254 printf("Unable to remove alias, Hermes response is: %s\n", $data->{'cause'});
255 logout();
256 exit;
257 }
258 printf("Removed alias %s.\n", $data->{'alias'} );
259 }
260
261 logout();
262 ################################################################################################
263 sub exec_apinode($$)
264 {
265 my $node = shift;
266 my $param = shift;
267
268 my ( $response, $data );
269
270 $session = "" if not defined $session;
271 $auth_key = "" if not defined $auth_key;
272 my $url = $config->api_url . "/" . $node;
273
274 $param->{'session'} = $session;
275 $param->{'auth_key'} = $auth_key;
276
277 $response = $g_ua->post( $url, $param );
278 if ( $response->is_success )
279 {
280 if ( $response->content =~ m/\s*{/ )
281 {
282 $data = decode_json( $response->content);
283 }
284 else
285 {
286 $data = $response->content;
287 }
288
289 }
290 return $data;
291 }
292
293 sub login_apikey
294 {
295 my $response = $g_ua->post( $config->api_url . "/auth/login",
296 [ "api_key" => $api_key ] );
297
298 my $data = decode_json( $response->content) if $response->is_success;
299 die("HTTP error") unless $response->is_success;
300
301 if ( $data->{'response'} eq "ok" )
302 {
303 $session = $data->{'session'};
304 $auth_key = $data->{'auth_key'};
305 }
306 else
307 {
308 print "Unable to log in to Hermes API\n";
309 exit;
310 }
311 undef $data; undef $response;
312 }
313
314 sub logout
315 {
316 my $response = $g_ua->post( $config->api_url . "/auth/logout",
317 [ "session" => $session ] );
318 die("HTTP error") unless $response->is_success;
319 undef $session; undef $auth_key;
320 }