path: root/FS/bin/freeside-cdrrewrited

#!/usr/bin/perl -w

use strict;
use vars qw( $conf );
use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig*
use FS::UID qw( adminsuidsetup );
use FS::Record qw( qsearch qsearchs dbh );
#use FS::cdr;
#use FS::cust_pkg;
#use FS::queue;

my $user = shift or die &usage;

#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs
daemonize1('freeside-cdrrewrited');

drop_root();

adminsuidsetup($user);

logfile( "%%%FREESIDE_LOG%%%/cdrrewrited-log.". $FS::UID::datasrc );

daemonize2();

$conf = new FS::Conf;

die "not running; relevant conf options are all off\n"
  unless _shouldrun();

#--

#used for taqua
my %sessionnum_unmatch = ();
my $sessionnum_retry = 4 * 60 * 60; # 4 hours
my $sessionnum_giveup = 4 * 24 * 60 * 60; # 4 days

my %cdr_type = map { lc($_->cdrtypename) => $_->cdrtypenum } 
  qsearch('cdr_type',{});

while (1) {

  #hmm... don't want to do an expensive search with an ever-growing bunch
  # of unprocessed CDRs during the month... better to mark them all as
  # rewritten "skipped", i.e. why we're a daemon in the first place
  # instead of just doing this search like normal CDRs

  #hmm :/
  #used only by taqua, should have no effect otherwise
  my @recent = grep { ($sessionnum_unmatch{$_} + $sessionnum_retry) > time }
                 keys %sessionnum_unmatch;
  my $extra_sql = scalar(@recent)
                    ? ' AND acctid NOT IN ('. join(',', @recent). ') '
                    : '';

  #order matters for removing dupes--only the first is preserved
  $extra_sql .= ' ORDER BY acctid '
    if $conf->exists('cdr-skip_duplicate_rewrite');

  my $found = 0;
  my %skip = (); #used only by taqua
  my %warning = ();

  foreach my $cdr ( 
    qsearch( {
      'table'     => 'cdr',
      'hashref'   => {},
      'extra_sql' => 'WHERE freesidestatus IS NULL '.
                     ' AND freesiderewritestatus IS NULL '.
                     $extra_sql.
                     ' LIMIT 1024 FOR UPDATE', #arbitrary, but don't eat too much memory
    } )
  ) {

    next if $skip{$cdr->acctid}; #used only by taqua

    $found = 1;
    my @status = ();

    if ($conf->exists('cdr-skip_duplicate_rewrite')) {
      #qsearch can't handle timestamp type of calldate
      my $sth = dbh->prepare(
        'SELECT 1 FROM cdr WHERE src=? AND dst=? AND calldate=? AND acctid < ? LIMIT 1'
      ) or die dbh->errstr;
      $sth->execute($cdr->src,$cdr->dst,$cdr->calldate,$cdr->acctid) or die $sth->errstr;
      my $isdup = $sth->fetchrow_hashref;
      $sth->finish;
      if ($isdup) {
        #we only act on this cdr, not touching previous dupes
        #if a dupe somehow creeped in previously, too late to fix it
        $cdr->freesidestatus('skipped'); #prevent it from being billed
        push(@status,'duplicate');
      }
    }

    if ( $conf->exists('cdr-asterisk_forward_rewrite')
         && $cdr->dstchannel =~ /^Local\/(\d+)/i && $1 ne $cdr->dst
       )
    {

      my $dst = $1;

      warn "dst ". $cdr->dst. " does not match dstchannel $dst ".
           "(". $cdr->dstchannel. "); rewriting CDR as a forwarded call";

      $cdr->charged_party($cdr->dst);
      $cdr->dst($dst);
      $cdr->amaflags(2);

      push @status, 'asterisk_forward';

    }

    # XXX weird special case stuff--can we modularize this somehow?
    # reference RT#16271
    if ( $conf->exists('cdr-asterisk_australia_rewrite') and
         $cdr->disposition eq 'ANSWERED' ) {
      my $dst = $cdr->dst;
      my $type;
      if ( $dst =~ /^0?(12|13|1800|1900|0055)/ ) {
        # toll free or smart numbers, any length
        $type = 'tollfree';
        $cdr->charged_party($dst);
      }
      elsif ( $dst =~ /^(11|0011)/ ) {
        # will be followed by country code
        $type = 'international';
        $dst =~ s/^$1/0011/; #standardize
        $cdr->dst($dst);
      }
      elsif ( length($dst) == 10 and$dst =~ /^04/ ) {
        $type = 'mobile';
      }
      elsif ( length($dst) == 10 and $dst =~ /^02|03|07|08/ ) {
        $type = 'domestic';
      }
      elsif ( length($dst) == 8 ) {
        # local call, no area code
        $type = 'domestic';
      }
      else {
        $type = 'other';
      }
      if ( $type and exists($cdr_type{$type}) ) {
        $cdr->cdrtypenum($cdr_type{$type});
        push @status, 'asterisk_australia';
      }
      else {
        $warning{"no CDR type defined for $type calls"}++;
      }
    }

    if ( $conf->exists('cdr-charged_party_rewrite') && ! $cdr->charged_party ) {

      $cdr->set_charged_party;
      push @status, 'charged_party';

    }

    if (     $cdr->cdrtypenum == 1
         and $cdr->lastapp
         and (
            $conf->exists('cdr-taqua-accountcode_rewrite') or
            $conf->exists('cdr-taqua-callerid_rewrite') )
       )
    {

      #find the matching CDR
      my %search = ( 'sessionnum' => $cdr->sessionnum );
      if ( $cdr->lastapp eq 'acctcode' ) {
        $search{'src'} = $cdr->subscriber;
      } elsif ( $cdr->lastapp eq 'CallerId' ) {
        $search{'dst'} = $cdr->subscriber;
      }
      my $primary = qsearchs('cdr', \%search);

      unless ( $primary ) {

        my $cantfind = "can't find primary CDR with session ". $cdr->sessionnum.
                       ", src ". $cdr->subscriber;
        if ( $cdr->calldate_unix + $sessionnum_giveup < time ) {
          warn "ERROR: $cantfind; giving up\n";
          push @status, 'taqua-sessionnum-NOTFOUND';
          $cdr->status('done'); #so it doesn't try to rate
          delete $sessionnum_unmatch{$cdr->acctid}; #so it doesn't suck mem
        } else {
          warn "WARNING: $cantfind; will keep trying\n";
          $sessionnum_unmatch{$cdr->acctid} = time;
          next;
        }

      } else {

        if ( $cdr->lastapp eq 'acctcode' ) {
          # lastdata contains the dialed account code
          $primary->accountcode( $cdr->lastdata );
          push @status, 'taqua-accountcode';
        } elsif ( $cdr->lastapp eq 'CallerId' ) {
          # lastdata contains "allowed" or "restricted"
          # or case variants thereof
          if ( lc($cdr->lastdata) eq 'restricted' ) {
            $primary->clid( 'PRIVATE' );
          }
          push @status, 'taqua-callerid';
        } else {
          warn "unknown Taqua service name: ".$cdr->lastapp."\n";
        }
        #$primary->freesiderewritestatus( 'taqua-accountcode-primary' );
        my $error = $primary->replace if $primary->modified;
        if ( $error ) {
          warn "WARNING: error rewriting primary CDR (will retry): $error\n";
          next;
        }
        $skip{$primary->acctid} = 1;

        $cdr->status('done'); #so it doesn't try to rate

      }

    }

    if ( $conf->exists('cdr-userfield_dnis_rewrite') and
         $cdr->userfield =~ /DNIS=(\d+)/ ) {
      $cdr->dst($1);
      push @status, 'userfield_dnis';
    }

    if ( $conf->exists('cdr-intl_to_domestic_rewrite') and
         $cdr->dst =~ /^(011)(\d{0,7})$/ ) {
      $cdr->dst($2);
      push @status, 'intl_to_domestic';
    }

    $cdr->freesiderewritestatus(
      scalar(@status) ? join('/', @status) : 'skipped'
    );

    my $error = $cdr->replace;

    if ( $error ) {
      warn "WARNING: error rewriting CDR (will retry in 30 seconds):".
           " $error\n";
      sleep 30; #i dunno, wait and see if the database comes back?
    }

    last if sigterm() || sigint();

  }

  foreach (sort keys %warning) {
    warn "WARNING: $_ (x $warning{$_})\n";
  }
  %warning = ();

  myexit() if sigterm() || sigint();
  #sleep 1 unless $found;
  sleep 5 unless $found;

}

#--

sub _shouldrun {
     $conf->exists('cdr-asterisk_forward_rewrite')
  || $conf->exists('cdr-asterisk_australia_rewrite')
  || $conf->exists('cdr-charged_party_rewrite')
  || $conf->exists('cdr-taqua-accountcode_rewrite')
  || $conf->exists('cdr-taqua-callerid_rewrite')
  || $conf->exists('cdr-intl_to_domestic_rewrite')
  || $conf->exists('cdr-userfield_dnis_rewrite')
  || $conf->exists('cdr-skip_duplicate_rewrite')
  || 0
  ;
}

sub usage { 
  die "Usage:\n\n  freeside-cdrrewrited user\n";
}

=head1 NAME

freeside-cdrrewrited - Real-time daemon for CDR rewriting

=head1 SYNOPSIS

  freeside-cdrrewrited

=head1 DESCRIPTION

Runs continuously, searches for CDRs and does forwarded-call rewriting if any
of the following config options are enabled:

=over 4

=item cdr-skip_duplicate_rewrite

Marks as 'skipped' (prevents billing for) any CDRs with 
a src, dst and calldate identical to an existing CDR

=item cdr-asterisk_australia_rewrite

Classifies Australian numbers as domestic, mobile, tollfree, international, or
"other", and tries to assign a cdrtypenum based on that.

=item cdr-asterisk_forward_rewrite

Identifies Asterisk forwarded calls using the 'dstchannel' field. If the
dstchannel is "Local/" followed by a number, but the number doesn't match the
dst field, the dst field will be rewritten to match.

=item cdr-charged_party_rewrite

Calls set_charged_party on all calls.

=item cdr-taqua-accountcode_rewrite

=item cdr-taqua-callerid_rewrite

These actually have the same effect. Taqua uses cdrtypenum = 1 to tag accessory
records. They will have "sessionnum" = that of the primary record, and
"lastapp" indicating their function:

- "acctcode": "lastdata" contains the dialed account code. Insert this into the
accountcode field of the primary record.

- "CallerId": "lastdata" contains "allowed" or "restricted". If "restricted"
then the clid field of the primary record is set to "PRIVATE".

=item cdr-intl_to_domestic_rewrite

Finds records where the destination number has the "011" international prefix,
but with seven or fewer digits in the rest of the number, and strips the "011"
prefix so that they will be treated as domestic calls. This is very uncommon.

=head1 SEE ALSO

=cut

1;