quiet option to cancel method
[freeside.git] / FS / FS / part_export / sqlradius.pm
1 package FS::part_export::sqlradius;
2
3 use vars qw(@ISA);
4 use FS::Record qw( dbh );
5 use FS::part_export;
6
7 @ISA = qw(FS::part_export);
8
9 sub rebless { shift; }
10
11 sub export_username {
12   my($self, $svc_acct) = (shift, shift);
13   $svc_acct->username;
14 }
15
16 sub _export_insert {
17   my($self, $svc_acct) = (shift, shift);
18
19   foreach my $table (qw(reply check)) {
20     my $method = "radius_$table";
21     my %attrib = $svc_acct->$method();
22     next unless keys %attrib;
23     my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
24       $table, $self->export_username($svc_acct), %attrib );
25     return $err_or_queue unless ref($err_or_queue);
26   }
27   my @groups = $svc_acct->radius_groups;
28   if ( @groups ) {
29     my $err_or_queue = $self->sqlradius_queue(
30       $svc_acct->svcnum, 'usergroup_insert',
31       $self->export_username($svc_acct), @groups );
32     return $err_or_queue unless ref($err_or_queue);
33   }
34   '';
35 }
36
37 sub _export_replace {
38   my( $self, $new, $old ) = (shift, shift, shift);
39
40   local $SIG{HUP} = 'IGNORE';
41   local $SIG{INT} = 'IGNORE';
42   local $SIG{QUIT} = 'IGNORE';
43   local $SIG{TERM} = 'IGNORE';
44   local $SIG{TSTP} = 'IGNORE';
45   local $SIG{PIPE} = 'IGNORE';
46
47   my $oldAutoCommit = $FS::UID::AutoCommit;
48   local $FS::UID::AutoCommit = 0;
49   my $dbh = dbh;
50
51   my $jobnum = '';
52   if ( $self->export_username($old) ne $self->export_username($new) ) {
53     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
54       $self->export_username($new), $self->export_username($old) );
55     unless ( ref($err_or_queue) ) {
56       $dbh->rollback if $oldAutoCommit;
57       return $err_or_queue;
58     }
59     $jobnum = $err_or_queue->jobnum;
60   }
61
62   foreach my $table (qw(reply check)) {
63     my $method = "radius_$table";
64     my %new = $new->$method();
65     my %old = $old->$method();
66     if ( grep { !exists $old{$_} #new attributes
67                 || $new{$_} ne $old{$_} #changed
68               } keys %new
69     ) {
70       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
71         $table, $self->export_username($new), %new );
72       unless ( ref($err_or_queue) ) {
73         $dbh->rollback if $oldAutoCommit;
74         return $err_or_queue;
75       }
76       if ( $jobnum ) {
77         my $error = $err_or_queue->depend_insert( $jobnum );
78         if ( $error ) {
79           $dbh->rollback if $oldAutoCommit;
80           return $error;
81         }
82       }
83     }
84
85     my @del = grep { !exists $new{$_} } keys %old;
86     if ( @del ) {
87       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
88         $table, $self->export_username($new), @del );
89       unless ( ref($err_or_queue) ) {
90         $dbh->rollback if $oldAutoCommit;
91         return $err_or_queue;
92       }
93       if ( $jobnum ) {
94         my $error = $err_or_queue->depend_insert( $jobnum );
95         if ( $error ) {
96           $dbh->rollback if $oldAutoCommit;
97           return $error;
98         }
99       }
100     }
101   }
102
103   # (sorta) false laziness with FS::svc_acct::replace
104   my @oldgroups = @{$old->usergroup}; #uuuh
105   my @newgroups = $new->radius_groups;
106   my @delgroups = ();
107   foreach my $oldgroup ( @oldgroups ) {
108     if ( grep { $oldgroup eq $_ } @newgroups ) {
109       @newgroups = grep { $oldgroup ne $_ } @newgroups;
110       next;
111     }
112     push @delgroups, $oldgroup;
113   }
114
115   if ( @delgroups ) {
116     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
117       $self->export_username($new), @delgroups );
118     unless ( ref($err_or_queue) ) {
119       $dbh->rollback if $oldAutoCommit;
120       return $err_or_queue;
121     }
122     if ( $jobnum ) {
123       my $error = $err_or_queue->depend_insert( $jobnum );
124       if ( $error ) {
125         $dbh->rollback if $oldAutoCommit;
126         return $error;
127       }
128     }
129   }
130
131   if ( @newgroups ) {
132     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
133       $self->export_username($new), @newgroups );
134     unless ( ref($err_or_queue) ) {
135       $dbh->rollback if $oldAutoCommit;
136       return $err_or_queue;
137     }
138     if ( $jobnum ) {
139       my $error = $err_or_queue->depend_insert( $jobnum );
140       if ( $error ) {
141         $dbh->rollback if $oldAutoCommit;
142         return $error;
143       }
144     }
145   }
146
147   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
148
149   '';
150 }
151
152 sub _export_delete {
153   my( $self, $svc_acct ) = (shift, shift);
154   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete',
155     $self->export_username($svc_acct) );
156   ref($err_or_queue) ? '' : $err_or_queue;
157 }
158
159 sub sqlradius_queue {
160   my( $self, $svcnum, $method ) = (shift, shift, shift);
161   my $queue = new FS::queue {
162     'svcnum' => $svcnum,
163     'job'    => "FS::part_export::sqlradius::sqlradius_$method",
164   };
165   $queue->insert(
166     $self->option('datasrc'),
167     $self->option('username'),
168     $self->option('password'),
169     @_,
170   ) or $queue;
171 }
172
173 sub sqlradius_insert { #subroutine, not method
174   my $dbh = sqlradius_connect(shift, shift, shift);
175   my( $table, $username, %attributes ) = @_;
176
177   foreach my $attribute ( keys %attributes ) {
178   
179     my $s_sth = $dbh->prepare(
180       "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?"
181     ) or die $dbh->errstr;
182     $s_sth->execute( $username, $attribute ) or die $s_sth->errstr;
183
184     if ( $s_sth->fetchrow_arrayref->[0] ) {
185
186       my $u_sth = $dbh->prepare(
187         "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?"
188       ) or die $dbh->errstr;
189       $u_sth->execute($attributes{$attribute}, $username, $attribute)
190         or die $u_sth->errstr;
191
192     } else {
193
194       my $i_sth = $dbh->prepare(
195         "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
196           "VALUES ( ?, ?, ?, ? )"
197       ) or die $dbh->errstr;
198       $i_sth->execute(
199         $username,
200         $attribute,
201         ( $attribute =~ /Password/i ? '==' : ':=' ),
202         $attributes{$attribute},
203       ) or die $i_sth->errstr;
204
205     }
206
207   }
208   $dbh->disconnect;
209 }
210
211 sub sqlradius_usergroup_insert { #subroutine, not method
212   my $dbh = sqlradius_connect(shift, shift, shift);
213   my( $username, @groups ) = @_;
214
215   my $sth = $dbh->prepare( 
216     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
217   ) or die $dbh->errstr;
218   foreach my $group ( @groups ) {
219     $sth->execute( $username, $group )
220       or die "can't insert into groupname table: ". $sth->errstr;
221   }
222   $dbh->disconnect;
223 }
224
225 sub sqlradius_usergroup_delete { #subroutine, not method
226   my $dbh = sqlradius_connect(shift, shift, shift);
227   my( $username, @groups ) = @_;
228
229   my $sth = $dbh->prepare( 
230     "DELETE FROM usergroup WHERE UserName = ? AND GroupName = ?"
231   ) or die $dbh->errstr;
232   foreach my $group ( @groups ) {
233     $sth->execute( $username, $group )
234       or die "can't delete from groupname table: ". $sth->errstr;
235   }
236   $dbh->disconnect;
237 }
238
239 sub sqlradius_rename { #subroutine, not method
240   my $dbh = sqlradius_connect(shift, shift, shift);
241   my($new_username, $old_username) = @_;
242   foreach my $table (qw(radreply radcheck usergroup )) {
243     my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?")
244       or die $dbh->errstr;
245     $sth->execute($new_username, $old_username)
246       or die "can't update $table: ". $sth->errstr;
247   }
248   $dbh->disconnect;
249 }
250
251 sub sqlradius_attrib_delete { #subroutine, not method
252   my $dbh = sqlradius_connect(shift, shift, shift);
253   my( $table, $username, @attrib ) = @_;
254
255   foreach my $attribute ( @attrib ) {
256     my $sth = $dbh->prepare(
257         "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" )
258       or die $dbh->errstr;
259     $sth->execute($username,$attribute)
260       or die "can't delete from rad$table table: ". $sth->errstr;
261   }
262   $dbh->disconnect;
263 }
264
265 sub sqlradius_delete { #subroutine, not method
266   my $dbh = sqlradius_connect(shift, shift, shift);
267   my $username = shift;
268
269   foreach my $table (qw( radcheck radreply usergroup )) {
270     my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
271     $sth->execute($username)
272       or die "can't delete from $table table: ". $sth->errstr;
273   }
274   $dbh->disconnect;
275 }
276
277 sub sqlradius_connect {
278   #my($datasrc, $username, $password) = @_;
279   #DBI->connect($datasrc, $username, $password) or die $DBI::errstr;
280   DBI->connect(@_) or die $DBI::errstr;
281 }
282