1 package FS::part_export::dma_radiusmanager;
4 use vars qw($DEBUG %info %options);
5 use base 'FS::part_export';
10 use Digest::MD5 'md5_hex';
12 use Locale::Country qw(code2country);
13 use Locale::SubCountry;
14 use Date::Format 'time2str';
16 tie %options, 'Tie::IxHash',
17 'dbname' => { label=>'Database name', default=>'radius' },
18 'username' => { label=>'Database username' },
19 'password' => { label=>'Database password' },
20 'manager' => { label=>'Manager name' },
21 'template_name' => { label=>'Template service name' },
22 'service_prefix' => { label=>'Service name prefix' },
23 'debug' => { label=>'Enable debugging', type=>'checkbox' },
28 'desc' => 'Export to DMA Radius Manager',
29 'options' => \%options,
38 my $datasrc = 'dbi:mysql:host='.$self->machine.
39 ':database='.$self->option('dbname');
42 $self->option('username'),
43 $self->option('password'),
45 ) or die $DBI::errstr;
48 sub export_insert { my $self = shift; $self->dma_rm_queue('insert', @_) }
49 sub export_delete { my $self = shift; $self->dma_rm_queue('delete', @_) }
50 sub export_replace { my $self = shift; $self->dma_rm_queue('replace', @_) }
51 sub export_suspend { my $self = shift; $self->dma_rm_queue('suspend', @_) }
52 sub export_unsuspend { my $self = shift; $self->dma_rm_queue('unsuspend', @_) }
55 my ($self, $action, $svc_acct, $old) = @_;
57 my $svcnum = $svc_acct->svcnum;
59 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
60 my $cust_main = $cust_pkg->cust_main;
62 my $address = $cust_main->address1;
63 $address .= ' '.$cust_main->address2 if $cust_main->address2;
64 my $country = code2country($cust_main->country);
65 my $lsc = Locale::SubCountry->new($cust_main->country);
66 my $state = $lsc->full_name($cust_main->state) if defined($lsc);
70 username => $svc_acct->username,
71 password => md5_hex($svc_acct->_password),
72 groupid => $self->option('groupid'),
74 firstname => $cust_main->first,
75 lastname => $cust_main->last,
76 company => $cust_main->company,
77 phone => ($cust_main->daytime || $cust_main->night),
78 mobile => $cust_main->mobile,
79 city => $cust_main->city,
80 state => $state, #full name
81 zip => $cust_main->zip,
82 country => $country, #full name
83 gpslat => $cust_main->latitude,
84 gpslong => $cust_main->longitude,
85 comment => 'svcnum'.$svcnum,
86 createdby => $self->option('manager'),
87 owner => $self->option('manager'),
88 email => $cust_main->invoicing_list_emailonly_scalar,
90 # used internally by the export
91 exportnum => $self->exportnum,
94 svcpart => $svc_acct->cust_svc->svcpart,
95 _password => $svc_acct->_password,
97 if ( $action eq 'replace' ) {
98 $params{'old_username'} = $old->username;
99 $params{'old_password'} = $old->_password;
101 my $queue = FS::queue->new({
103 'job' => "FS::part_export::dma_radiusmanager::dma_rm_action",
105 $queue->insert(%params);
110 my $svcnum = delete $params{svcnum};
111 my $action = delete $params{action};
112 my $svcpart = delete $params{svcpart};
113 my $exportnum = delete $params{exportnum};
115 my $username = $params{username};
116 my $password = delete $params{_password};
118 my $self = FS::part_export->by_key($exportnum);
119 my $dbh = $self->connect;
120 local $DEBUG = 1 if $self->option('debug');
122 # export the part_svc if needed, and get its srvid
123 my $part_svc = FS::part_svc->by_key($svcpart);
124 my $srvid = $self->export_part_svc($part_svc, $dbh); # dies on error
125 $params{srvid} = $srvid;
127 if ( $action eq 'insert' ) {
128 $params{'createdon'} = time2str('%Y-%m-%d', time);
129 $params{'expiration'} = time2str('%Y-%m-%d', time);
130 warn "rm_users: inserting svcnum$svcnum\n" if $DEBUG;
131 my $sth = $dbh->prepare( 'INSERT INTO rm_users ( '.
132 join(', ', keys(%params)).
134 join(', ', ('?') x keys(%params)).
137 $sth->execute(values(%params)) or die $dbh->errstr;
139 # minor false laziness w/ sqlradius_insert
140 warn "radcheck: inserting $username\n" if $DEBUG;
141 $sth = $dbh->prepare( 'INSERT INTO radcheck (
142 username, attribute, op, value
143 ) VALUES (?, ?, ?, ?)' );
146 'Cleartext-Password',
149 ) or die $dbh->errstr;
155 1, # should this be an option?
156 ) or die $dbh->errstr;
157 # also, we don't support exporting any other radius attrs...
158 # those should go in 'custattr' if we need them
159 } elsif ( $action eq 'replace' ) {
161 my $old_username = delete $params{old_username};
162 my $old_password = delete $params{old_password};
163 # svcnum is invariant and on the remote side, so we don't need any
164 # of the old fields to do this
165 warn "rm_users: updating svcnum$svcnum\n" if $DEBUG;
166 my $sth = $dbh->prepare( 'UPDATE rm_users SET '.
167 join(', ', map { "$_ = ?" } keys(%params)).
170 $sth->execute(values(%params), $params{comment}) or die $dbh->errstr;
171 # except for username/password changes
172 if ( $old_password ne $password ) {
173 warn "radcheck: changing password for $old_username\n" if $DEBUG;
174 $sth = $dbh->prepare( 'UPDATE radcheck SET value = ? '.
175 'WHERE username = ? and attribute = \'Cleartext-Password\''
177 $sth->execute($password, $old_username) or die $dbh->errstr;
179 if ( $old_username ne $username ) {
180 warn "radcheck: changing username $old_username to $username\n"
182 $sth = $dbh->prepare( 'UPDATE radcheck SET username = ? '.
185 $sth->execute($username, $old_username) or die $dbh->errstr;
188 } elsif ( $action eq 'suspend' ) {
191 warn "rm_users: disabling svcnum#$svcnum\n" if $DEBUG;
192 my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 0 '.
195 $sth->execute($params{comment}) or die $dbh->errstr;
197 } elsif ( $action eq 'unsuspend' ) {
199 warn "rm_users: enabling svcnum#$svcnum\n" if $DEBUG;
200 my $sth = $dbh->prepare( 'UPDATE rm_users SET enableuser = 1 '.
203 $sth->execute($params{comment}) or die $dbh->errstr;
205 } elsif ( $action eq 'delete' ) {
207 warn "rm_users: deleting svcnum#$svcnum\n" if $DEBUG;
208 my $sth = $dbh->prepare( 'DELETE FROM rm_users WHERE comment = ?' );
209 $sth->execute($params{comment}) or die $dbh->errstr;
211 warn "radcheck: deleting $username\n" if $DEBUG;
212 $sth = $dbh->prepare( 'DELETE FROM radcheck WHERE username = ?' );
213 $sth->execute($username) or die $dbh->errstr;
215 # if this were smarter it would also delete the rm_services record
216 # if it was no longer in use, but that's not really necessary
223 =item export_part_svc PART_SVC DBH
225 Query Radius Manager for a service definition matching the name of
226 PART_SVC (optionally with a prefix defined in the export options).
227 If there is one, update it to match the attributes of PART_SVC; if
228 not, create one. Then return its srvid.
232 sub export_part_svc {
233 my ($self, $part_svc, $dbh) = @_;
235 # if $dbh exists, use the existing transaction
236 # otherwise create our own and commit when finished
239 $dbh = $self->connect;
243 my $name = $self->option('service_prefix').$part_svc->svc;
247 'enableservice' => 1,
249 'dailynextsrvid' => -1,
250 # force price-related fields to zero
254 'unitpriceaddtax' => 0,
257 # use speed settings from fixed usergroups configured on this part_svc
258 if ( my $psc = $part_svc->part_svc_column('usergroup') ) {
259 # each part_svc really should only have one fixed group with non-null
260 # speed settings, but go by priority order for consistency
262 sort { $a->priority <=> $b->priority }
264 map { FS::radius_group->by_key($_) }
265 split(/\s*,\s*/, $psc->columnvalue);
266 } # otherwise there are no fixed groups, so leave speed empty
268 foreach (qw(down up)) {
269 my $speed = "speed_$_";
270 foreach my $group (@fixed_groups) {
271 if ( ($group->$speed || 0) > 0 ) {
272 $params{$_.'rate'} = $group->$speed;
277 # anything else we need here? poolname, maybe?
279 warn "rm_services: looking for '$name'\n" if $DEBUG;
280 my $sth = $dbh->prepare(
281 'SELECT srvid FROM rm_services WHERE srvname = ? AND enableservice = 1'
283 $sth->execute($name) or die $dbh->errstr;
284 if ( $sth->rows > 1 ) {
285 die "Multiple services with name '$name' found in Radius Manager.\n";
287 } elsif ( $sth->rows == 0 ) {
288 # leave this blank to disable creating new service defs
289 my $template_name = $self->option('template_name');
291 die "Can't create a new service profile--no template service specified.\n"
292 unless $template_name;
294 warn "rm_services: fetching template '$template_name'\n" if $DEBUG;
295 $sth = $dbh->prepare('SELECT * FROM rm_services WHERE srvname = ? LIMIT 1');
296 $sth->execute($template_name);
297 die "Can't create a new service profile--template service ".
298 "'$template_name' not found.\n" unless $sth->rows == 1;
299 my $template = $sth->fetchrow_hashref;
300 %params = (%$template, %params);
302 # get the next available srvid
303 $sth = $dbh->prepare('SELECT MAX(srvid) FROM rm_services');
304 $sth->execute or die $dbh->errstr;
307 $srvid = $sth->fetchrow_arrayref->[0] + 1;
309 $params{'srvid'} = $srvid;
311 # create a new one based on the template
312 warn "rm_services: inserting '$name' as srvid#$srvid\n" if $DEBUG;
313 $sth = $dbh->prepare(
314 'INSERT INTO rm_services ('.join(', ', keys %params).
315 ') VALUES ('.join(', ', map {'?'} keys %params).')'
317 $sth->execute(values(%params)) or die $dbh->errstr;
318 # also link it to all the managers allowed on the template service
319 warn "rm_services: linking to manager\n" if $DEBUG;
320 $sth = $dbh->prepare(
321 'INSERT INTO rm_allowedmanagers (srvid, managername) '.
322 'SELECT ?, managername FROM rm_allowedmanagers WHERE srvid = ?'
324 $sth->execute($srvid, $template->{srvid}) or die $dbh->errstr;
325 # and the same for NASes
326 warn "rm_services: linking to nas\n" if $DEBUG;
327 $sth = $dbh->prepare(
328 'INSERT INTO rm_allowednases (srvid, nasid) '.
329 'SELECT ?, nasid FROM rm_allowednases WHERE srvid = ?'
331 $sth->execute($srvid, $template->{srvid}) or die $dbh->errstr;
333 $dbh->commit if $commit;
336 } else { # $sth->rows == 1, it already exists
338 my $row = $sth->fetchrow_arrayref;
339 my $srvid = $row->[0];
340 warn "rm_services: updating srvid#$srvid\n" if $DEBUG;
341 $sth = $dbh->prepare(
342 'UPDATE rm_services SET '.join(', ', map {"$_ = ?"} keys %params) .
345 $sth->execute(values(%params), $srvid) or die $dbh->errstr;
347 $dbh->commit if $commit;