1745d67a0ab79985911edb1b8d8ad11ecce9debe
[freeside.git] / FS / bin / freeside-cdrrewrited
1 #!/usr/bin/perl -w
2
3 use strict;
4 use vars qw( $conf );
5 use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig*
6 use FS::UID qw( adminsuidsetup );
7 use FS::Record qw( qsearch qsearchs dbh );
8 #use FS::cdr;
9 #use FS::cust_pkg;
10 #use FS::queue;
11
12 my $user = shift or die &usage;
13
14 #daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs
15 daemonize1('freeside-cdrrewrited');
16
17 drop_root();
18
19 adminsuidsetup($user);
20
21 logfile( "%%%FREESIDE_LOG%%%/cdrrewrited-log.". $FS::UID::datasrc );
22
23 daemonize2();
24
25 $conf = new FS::Conf;
26
27 die "not running; relevant conf options are all off\n"
28   unless _shouldrun();
29
30 #--
31
32 #used for taqua
33 my %sessionnum_unmatch = ();
34 my $sessionnum_retry = 4 * 60 * 60; # 4 hours
35 my $sessionnum_giveup = 4 * 24 * 60 * 60; # 4 days
36
37 my %cdr_type = map { lc($_->cdrtypename) => $_->cdrtypenum } 
38   qsearch('cdr_type',{});
39
40 while (1) {
41
42   #hmm... don't want to do an expensive search with an ever-growing bunch
43   # of unprocessed CDRs during the month... better to mark them all as
44   # rewritten "skipped", i.e. why we're a daemon in the first place
45   # instead of just doing this search like normal CDRs
46
47   #hmm :/
48   #used only by taqua, should have no effect otherwise
49   my @recent = grep { ($sessionnum_unmatch{$_} + $sessionnum_retry) > time }
50                  keys %sessionnum_unmatch;
51   my $extra_sql = scalar(@recent)
52                     ? ' AND acctid NOT IN ('. join(',', @recent). ') '
53                     : '';
54
55   #order matters for removing dupes--only the first is preserved
56   $extra_sql .= ' ORDER BY acctid '
57     if $conf->exists('cdr-skip_duplicate_rewrite');
58
59   my $found = 0;
60   my %skip = (); #used only by taqua
61   my %warning = ();
62
63   foreach my $cdr ( 
64     qsearch( {
65       'table'     => 'cdr',
66       'extra_sql' => 'FOR UPDATE', #XXX overwritten by opt below...would fixing this break anything?
67       'hashref'   => {},
68       'extra_sql' => 'WHERE freesidestatus IS NULL '.
69                      ' AND freesiderewritestatus IS NULL '.
70                      $extra_sql.
71                      ' LIMIT 1024', #arbitrary, but don't eat too much memory
72     } )
73   ) {
74
75     next if $skip{$cdr->acctid}; #used only by taqua
76
77     $found = 1;
78     my @status = ();
79
80     if ($conf->exists('cdr-skip_duplicate_rewrite')) {
81       #qsearch can't handle timestamp type of calldate
82       my $sth = dbh->prepare(
83         'SELECT 1 FROM cdr WHERE src=? AND dst=? AND calldate=? AND acctid < ? LIMIT 1'
84       ) or die dbh->errstr;
85       $sth->execute($cdr->src,$cdr->dst,$cdr->calldate,$cdr->acctid) or die $sth->errstr;
86       my $isdup = $sth->fetchrow_hashref;
87       $sth->finish;
88       if ($isdup) {
89         #we only act on this cdr, not touching previous dupes
90         #if a dupe somehow creeped in previously, too late to fix it
91         $cdr->freesidestatus('done'); #prevent it from being billed
92         push(@status,'duplicate');
93       }
94     }
95
96     if ( $conf->exists('cdr-asterisk_forward_rewrite')
97          && $cdr->dstchannel =~ /^Local\/(\d+)/i && $1 ne $cdr->dst
98        )
99     {
100
101       my $dst = $1;
102
103       warn "dst ". $cdr->dst. " does not match dstchannel $dst ".
104            "(". $cdr->dstchannel. "); rewriting CDR as a forwarded call";
105
106       $cdr->charged_party($cdr->dst);
107       $cdr->dst($dst);
108       $cdr->amaflags(2);
109
110       push @status, 'asterisk_forward';
111
112     }
113
114     # XXX weird special case stuff--can we modularize this somehow?
115     # reference RT#16271
116     if ( $conf->exists('cdr-asterisk_australia_rewrite') and
117          $cdr->disposition eq 'ANSWERED' ) {
118       my $dst = $cdr->dst;
119       my $type;
120       if ( $dst =~ /^0?(12|13|1800|1900|0055)/ ) {
121         # toll free or smart numbers, any length
122         $type = 'tollfree';
123         $cdr->charged_party($dst);
124       }
125       elsif ( $dst =~ /^(11|0011)/ ) {
126         # will be followed by country code
127         $type = 'international';
128         $dst =~ s/^$1/0011/; #standardize
129         $cdr->dst($dst);
130       }
131       elsif ( length($dst) == 10 and$dst =~ /^04/ ) {
132         $type = 'mobile';
133       }
134       elsif ( length($dst) == 10 and $dst =~ /^02|03|07|08/ ) {
135         $type = 'domestic';
136       }
137       elsif ( length($dst) == 8 ) {
138         # local call, no area code
139         $type = 'domestic';
140       }
141       else {
142         $type = 'other';
143       }
144       if ( $type and exists($cdr_type{$type}) ) {
145         $cdr->cdrtypenum($cdr_type{$type});
146         push @status, 'asterisk_australia';
147       }
148       else {
149         $warning{"no CDR type defined for $type calls"}++;
150       }
151     }
152
153     if ( $conf->exists('cdr-charged_party_rewrite') && ! $cdr->charged_party ) {
154
155       $cdr->set_charged_party;
156       push @status, 'charged_party';
157
158     }
159
160     if (     $cdr->cdrtypenum == 1
161          and $cdr->lastapp
162          and (
163             $conf->exists('cdr-taqua-accountcode_rewrite') or
164             $conf->exists('cdr-taqua-callerid_rewrite') )
165        )
166     {
167
168       #find the matching CDR
169       my %search = ( 'sessionnum' => $cdr->sessionnum );
170       if ( $cdr->lastapp eq 'acctcode' ) {
171         $search{'src'} = $cdr->subscriber;
172       } elsif ( $cdr->lastapp eq 'CallerId' ) {
173         $search{'dst'} = $cdr->subscriber;
174       }
175       my $primary = qsearchs('cdr', \%search);
176
177       unless ( $primary ) {
178
179         my $cantfind = "can't find primary CDR with session ". $cdr->sessionnum.
180                        ", src ". $cdr->subscriber;
181         if ( $cdr->calldate_unix + $sessionnum_giveup < time ) {
182           warn "ERROR: $cantfind; giving up\n";
183           push @status, 'taqua-sessionnum-NOTFOUND';
184           $cdr->status('done'); #so it doesn't try to rate
185           delete $sessionnum_unmatch{$cdr->acctid}; #so it doesn't suck mem
186         } else {
187           warn "WARNING: $cantfind; will keep trying\n";
188           $sessionnum_unmatch{$cdr->acctid} = time;
189           next;
190         }
191
192       } else {
193
194         if ( $cdr->lastapp eq 'acctcode' ) {
195           # lastdata contains the dialed account code
196           $primary->accountcode( $cdr->lastdata );
197           push @status, 'taqua-accountcode';
198         } elsif ( $cdr->lastapp eq 'CallerId' ) {
199           # lastdata contains "allowed" or "restricted"
200           # or case variants thereof
201           if ( lc($cdr->lastdata) eq 'restricted' ) {
202             $primary->clid( 'PRIVATE' );
203           }
204           push @status, 'taqua-callerid';
205         } else {
206           warn "unknown Taqua service name: ".$cdr->lastapp."\n";
207         }
208         #$primary->freesiderewritestatus( 'taqua-accountcode-primary' );
209         my $error = $primary->replace if $primary->modified;
210         if ( $error ) {
211           warn "WARNING: error rewriting primary CDR (will retry): $error\n";
212           next;
213         }
214         $skip{$primary->acctid} = 1;
215
216         $cdr->status('done'); #so it doesn't try to rate
217
218       }
219
220     }
221
222     if ( $conf->exists('cdr-intl_to_domestic_rewrite') and
223          $cdr->dst =~ /^(011)(\d{0,7})$/ ) {
224       $cdr->dst($2);
225       push @status, 'intl_to_domestic';
226     }
227
228     $cdr->freesiderewritestatus(
229       scalar(@status) ? join('/', @status) : 'skipped'
230     );
231
232     my $error = $cdr->replace;
233
234     if ( $error ) {
235       warn "WARNING: error rewriting CDR (will retry in 30 seconds):".
236            " $error\n";
237       sleep 30; #i dunno, wait and see if the database comes back?
238     }
239
240     last if sigterm() || sigint();
241
242   }
243
244   foreach (sort keys %warning) {
245     warn "WARNING: $_ (x $warning{$_})\n";
246   }
247   %warning = ();
248
249   myexit() if sigterm() || sigint();
250   #sleep 1 unless $found;
251   sleep 5 unless $found;
252
253 }
254
255 #--
256
257 sub _shouldrun {
258      $conf->exists('cdr-asterisk_forward_rewrite')
259   || $conf->exists('cdr-asterisk_australia_rewrite')
260   || $conf->exists('cdr-charged_party_rewrite')
261   || $conf->exists('cdr-taqua-accountcode_rewrite')
262   || $conf->exists('cdr-taqua-callerid_rewrite')
263   || $conf->exists('cdr-intl_to_domestic_rewrite')
264   || $conf->exists('cdr-skip_duplicate_rewrite')
265   || 0
266   ;
267 }
268
269 sub usage { 
270   die "Usage:\n\n  freeside-cdrrewrited user\n";
271 }
272
273 =head1 NAME
274
275 freeside-cdrrewrited - Real-time daemon for CDR rewriting
276
277 =head1 SYNOPSIS
278
279   freeside-cdrrewrited
280
281 =head1 DESCRIPTION
282
283 Runs continuously, searches for CDRs and does forwarded-call rewriting if any
284 of the following config options are enabled:
285
286 =over 4
287
288 =item cdr-skip_duplicate_rewrite
289
290 Marks as 'done' (prevents billing for) any CDRs with 
291 a src, dst and calldate identical to an existing CDR
292
293 =item cdr-asterisk_australia_rewrite
294
295 Classifies Australian numbers as domestic, mobile, tollfree, international, or
296 "other", and tries to assign a cdrtypenum based on that.
297
298 =item cdr-asterisk_forward_rewrite
299
300 Identifies Asterisk forwarded calls using the 'dstchannel' field. If the
301 dstchannel is "Local/" followed by a number, but the number doesn't match the
302 dst field, the dst field will be rewritten to match.
303
304 =item cdr-charged_party_rewrite
305
306 Calls set_charged_party on all calls.
307
308 =item cdr-taqua-accountcode_rewrite
309
310 =item cdr-taqua-callerid_rewrite
311
312 These actually have the same effect. Taqua uses cdrtypenum = 1 to tag accessory
313 records. They will have "sessionnum" = that of the primary record, and
314 "lastapp" indicating their function:
315
316 - "acctcode": "lastdata" contains the dialed account code. Insert this into the
317 accountcode field of the primary record.
318
319 - "CallerId": "lastdata" contains "allowed" or "restricted". If "restricted"
320 then the clid field of the primary record is set to "PRIVATE".
321
322 =item cdr-intl_to_domestic_rewrite
323
324 Finds records where the destination number has the "011" international prefix,
325 but with seven or fewer digits in the rest of the number, and strips the "011"
326 prefix so that they will be treated as domestic calls. This is very uncommon.
327
328 =head1 SEE ALSO
329
330 =cut
331
332 1;