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 );
   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; cdr-asterisk_forward_rewrite, cdr-charged_party_rewrite ".
  28     " and cdr-taqua-accountcode_rewrite conf options are all off\n"
  29   unless _shouldrun();
  30
  31 #--
  32
  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   my @recent = grep { ($sessionnum_unmatch{$_} + $sessionnum_retry) > time }
  49                  keys %sessionnum_unmatch;
  50   my $extra_sql = scalar(@recent)
  51                     ? ' AND acctid NOT IN ('. join(',', @recent). ') '
  52                     : '';
  53
  54   my $found = 0;
  55   my %skip = ();
  56   my %warning = ();
  57
  58   foreach my $cdr (
  59     qsearch( {
  60       'table'     => 'cdr',
  61       'extra_sql' => 'FOR UPDATE',
  62       'hashref'   => {},
  63       'extra_sql' => 'WHERE freesidestatus IS NULL '.
  64                      ' AND freesiderewritestatus IS NULL '.
  65                      $extra_sql.
  66                      ' LIMIT 1024', #arbitrary, but don't eat too much memory
  67     } )
  68   ) {
  69
  70     next if $skip{$cdr->acctid};
  71
  72     $found = 1;
  73     my @status = ();
  74
  75     if ( $conf->exists('cdr-asterisk_forward_rewrite')
  76          && $cdr->dstchannel =~ /^Local\/(\d+)/i && $1 ne $cdr->dst
  77        )
  78     {
  79
  80       my $dst = $1;
  81
  82       warn "dst ". $cdr->dst. " does not match dstchannel $dst ".
  83            "(". $cdr->dstchannel. "); rewriting CDR as a forwarded call";
  84
  85       $cdr->charged_party($cdr->dst);
  86       $cdr->dst($dst);
  87       $cdr->amaflags(2);
  88
  89       push @status, 'asterisk_forward';
  90
  91     }
  92
  93     # XXX weird special case stuff--can we modularize this somehow?
  94     # reference RT#16271
  95     if ( $conf->exists('cdr-asterisk_australia_rewrite') and
  96          $cdr->disposition eq 'ANSWERED' ) {
  97       my $dst = $cdr->dst;
  98       my $type;
  99       if ( $dst =~ /^0?(12|13|1800|1900|0055)/ ) {
 100         # toll free or smart numbers, any length
 101         $type = 'tollfree';
 102         $cdr->charged_party($dst);
 103       }
 104       elsif ( $dst =~ /^(11|0011)/ ) {
 105         # will be followed by country code
 106         $type = 'international';
 107         $dst =~ s/^$1/0011/; #standardize
 108         $cdr->dst($dst);
 109       }
 110       elsif ( length($dst) == 10 and$dst =~ /^04/ ) {
 111         $type = 'mobile';
 112       }
 113       elsif ( length($dst) == 10 and $dst =~ /^02|03|07|08/ ) {
 114         $type = 'domestic';
 115       }
 116       elsif ( length($dst) == 8 ) {
 117         # local call, no area code
 118         $type = 'domestic';
 119       }
 120       else {
 121         $type = 'other';
 122       }
 123       if ( $type and exists($cdr_type{$type}) ) {
 124         $cdr->cdrtypenum($cdr_type{$type});
 125         push @status, 'asterisk_australia';
 126       }
 127       else {
 128         $warning{"no CDR type defined for $type calls"}++;
 129       }
 130     }
 131
 132     if ( $conf->exists('cdr-charged_party_rewrite') && ! $cdr->charged_party ) {
 133
 134       $cdr->set_charged_party;
 135       push @status, 'charged_party';
 136
 137     }
 138
 139     if (     $cdr->cdrtypenum == 1
 140          and $cdr->lastapp
 141          and (
 142             $conf->exists('cdr-taqua-accountcode_rewrite') or
 143             $conf->exists('cdr-taqua-callerid_rewrite') )
 144        )
 145     {
 146
 147       #find the matching CDR
 148       my %search = ( 'sessionnum' => $cdr->sessionnum );
 149       if ( $cdr->lastapp eq 'acctcode' ) {
 150         $search{'src'} = $cdr->subscriber;
 151       } elsif ( $cdr->lastapp eq 'CallerId' ) {
 152         $search{'dst'} = $cdr->subscriber;
 153       }
 154       my $primary = qsearchs('cdr', \%search);
 155
 156       unless ( $primary ) {
 157
 158         my $cantfind = "can't find primary CDR with session ". $cdr->sessionnum.
 159                        ", src ". $cdr->subscriber;
 160         if ( $cdr->calldate_unix + $sessionnum_giveup < time ) {
 161           warn "ERROR: $cantfind; giving up\n";
 162           push @status, 'taqua-sessionnum-NOTFOUND';
 163           $cdr->status('done'); #so it doesn't try to rate
 164           delete $sessionnum_unmatch{$cdr->acctid}; #so it doesn't suck mem
 165         } else {
 166           warn "WARNING: $cantfind; will keep trying\n";
 167           $sessionnum_unmatch{$cdr->acctid} = time;
 168           next;
 169         }
 170
 171       } else {
 172
 173         if ( $cdr->lastapp eq 'acctcode' ) {
 174           # lastdata contains the dialed account code
 175           $primary->accountcode( $cdr->lastdata );
 176           push @status, 'taqua-accountcode';
 177         } elsif ( $cdr->lastapp eq 'CallerId' ) {
 178           # lastdata contains "allowed" or "restricted"
 179           # or case variants thereof
 180           if ( lc($cdr->lastdata) eq 'restricted' ) {
 181             $primary->clid( 'PRIVATE' );
 182           }
 183           push @status, 'taqua-callerid';
 184         } else {
 185           warn "unknown Taqua service name: ".$cdr->lastapp."\n";
 186         }
 187         #$primary->freesiderewritestatus( 'taqua-accountcode-primary' );
 188         my $error = $primary->replace if $primary->modified;
 189         if ( $error ) {
 190           warn "WARNING: error rewriting primary CDR (will retry): $error\n";
 191           next;
 192         }
 193         $skip{$primary->acctid} = 1;
 194
 195         $cdr->status('done'); #so it doesn't try to rate
 196
 197       }
 198
 199     }
 200
 201     if ( $conf->exists('cdr-intl_to_domestic_rewrite') and
 202          $cdr->dst =~ /^(011)(\d{0,7})$/ ) {
 203       $cdr->dst($2);
 204       push @status, 'intl_to_domestic';
 205     }
 206
 207     $cdr->freesiderewritestatus(
 208       scalar(@status) ? join('/', @status) : 'skipped'
 209     );
 210
 211     my $error = $cdr->replace;
 212
 213     if ( $error ) {
 214       warn "WARNING: error rewriting CDR (will retry in 30 seconds):".
 215            " $error\n";
 216       sleep 30; #i dunno, wait and see if the database comes back?
 217     }
 218
 219     last if sigterm() || sigint();
 220
 221   }
 222
 223   foreach (sort keys %warning) {
 224     warn "WARNING: $_ (x $warning{$_})\n";
 225   }
 226   %warning = ();
 227
 228   myexit() if sigterm() || sigint();
 229   #sleep 1 unless $found;
 230   sleep 5 unless $found;
 231
 232 }
 233
 234 #--
 235
 236 sub _shouldrun {
 237      $conf->exists('cdr-asterisk_forward_rewrite')
 238   || $conf->exists('cdr-asterisk_australia_rewrite')
 239   || $conf->exists('cdr-charged_party_rewrite')
 240   || $conf->exists('cdr-taqua-accountcode_rewrite')
 241   || $conf->exists('cdr-taqua-callerid_rewrite')
 242   || $conf->exists('cdr-intl_to_domestic_rewrite')
 243   || 0
 244   ;
 245 }
 246
 247 sub usage {
 248   die "Usage:\n\n  freeside-cdrrewrited user\n";
 249 }
 250
 251 =head1 NAME
 252
 253 freeside-cdrrewrited - Real-time daemon for CDR rewriting
 254
 255 =head1 SYNOPSIS
 256
 257   freeside-cdrrewrited
 258
 259 =head1 DESCRIPTION
 260
 261 Runs continuously, searches for CDRs and does forwarded-call rewriting if any
 262 of the following config options are enabled:
 263
 264 =over 4
 265
 266 =item cdr-asterisk_australia_rewrite
 267
 268 Classifies Australian numbers as domestic, mobile, tollfree, international, or
 269 "other", and tries to assign a cdrtypenum based on that.
 270
 271 =item cdr-asterisk_forward_rewrite
 272
 273 Identifies Asterisk forwarded calls using the 'dstchannel' field. If the
 274 dstchannel is "Local/" followed by a number, but the number doesn't match the
 275 dst field, the dst field will be rewritten to match.
 276
 277 =item cdr-charged_party_rewrite
 278
 279 Calls set_charged_party on all calls.
 280
 281 =item cdr-taqua-accountcode_rewrite
 282
 283 =item cdr-taqua-callerid_rewrite
 284
 285 These actually have the same effect. Taqua uses cdrtypenum = 1 to tag accessory
 286 records. They will have "sessionnum" = that of the primary record, and
 287 "lastapp" indicating their function:
 288
 289 - "acctcode": "lastdata" contains the dialed account code. Insert this into the
 290 accountcode field of the primary record.
 291
 292 - "CallerId": "lastdata" contains "allowed" or "restricted". If "restricted"
 293 then the clid field of the primary record is set to "PRIVATE".
 294
 295 =item cdr-intl_to_domestic_rewrite
 296
 297 Finds records where the destination number has the "011" international prefix,
 298 but with seven or fewer digits in the rest of the number, and strips the "011"
 299 prefix so that they will be treated as domestic calls. This is very uncommon.
 300
 301 =head1 SEE ALSO
 302
 303 =cut
 304
 305 1;