FS/FS/part_export/cp.pm

   1 package FS::part_export::cp;
   2
   3 use vars qw(@ISA %info);
   4 use Tie::IxHash;
   5 use FS::part_export;
   6
   7 @ISA = qw(FS::part_export);
   8
   9 tie my %options, 'Tie::IxHash',
  10   'port'      => { label=>'Port number' },
  11   'username'  => { label=>'Username' },
  12   'password'  => { label=>'Password' },
  13   'domain'    => { label=>'Domain' },
  14   'workgroup' => { label=>'Default Workgroup' },
  15 ;
  16
  17 %info = (
  18   'svc'    => 'svc_acct',
  19   'desc'   => 'Real-time export to Critical Path Account Provisioning Protocol',
  20   'options'=> \%options,
  21   'notes'  => <<'END'
  22 Real-time export to
  23 <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>.
  24 Requires installation of
  25 <a href="http://search.cpan.org/dist/Net-APP">Net::APP</a>
  26 from CPAN.
  27 END
  28 );
  29
  30 sub rebless { shift; }
  31
  32 sub _export_insert {
  33   my( $self, $svc_acct ) = (shift, shift);
  34   $self->cp_queue( $svc_acct->svcnum, 'create_mailbox',
  35     'Mailbox'   => $svc_acct->username,
  36     'Password'  => $svc_acct->_password,
  37     'Workgroup' => $self->option('workgroup'),
  38     'Domain'    => $svc_acct->domain,
  39   );
  40 }
  41
  42 sub _export_replace {
  43   my( $self, $new, $old ) = (shift, shift, shift);
  44   return "can't change domain with Critical Path"
  45     if $old->domain ne $new->domain;
  46   return "can't change username with Critical Path" #CP no longer supports this
  47     if $old->username ne $new->username;
  48   return '' unless $old->_password ne $new->_password;
  49   $self->cp_queue( $new->svcnum, 'replace', $new->domain,
  50     $old->username, $new->username, $old->_password, $new->_password );
  51 }
  52
  53 sub _export_delete {
  54   my( $self, $svc_acct ) = (shift, shift);
  55   $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox',
  56     'Mailbox'   => $svc_acct->username,
  57     'Domain'    => $svc_acct->domain,
  58   );
  59 }
  60
  61 sub _export_suspend {
  62   my( $self, $svc_acct ) = (shift, shift);
  63   $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status',
  64     'Mailbox'       => $svc_acct->username,
  65     'Domain'        => $svc_acct->domain,
  66     'OTHER'         => 'T',
  67     'OTHER_SUSPEND' => 'T',
  68   );
  69 }
  70
  71 sub _export_unsuspend {
  72   my( $self, $svc_acct ) = (shift, shift);
  73   $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status',
  74     'Mailbox'       => $svc_acct->username,
  75     'Domain'        => $svc_acct->domain,
  76     'PAYMENT'       => 'F',
  77     'OTHER'         => 'F',
  78     'OTHER_SUSPEND' => 'F',
  79     'OTHER_BOUNCE'  => 'F',
  80   );
  81 }
  82
  83 sub cp_queue {
  84   my( $self, $svcnum, $method ) = (shift, shift, shift);
  85   my $queue = new FS::queue {
  86     'svcnum' => $svcnum,
  87     'job'    => 'FS::part_export::cp::cp_command',
  88   };
  89   $queue->insert(
  90     $self->machine,
  91     $self->option('port'),
  92     $self->option('username'),
  93     $self->option('password'),
  94     $self->option('domain'),
  95     $method,
  96     @_,
  97   );
  98 }
  99
 100 sub cp_command { #subroutine, not method
 101   my($host, $port, $username, $password, $login_domain, $method, @args) = @_;
 102
 103   #quelle hack
 104   if ( $method eq 'replace' ) {
 105
 106     my( $domain, $old_username, $new_username, $old_password, $new_password)
 107       = @args;
 108
 109     if ( $old_username ne $new_username ) {
 110       cp_command($host, $port, $username, $password, 'rename_mailbox',
 111         Domain        => $domain,
 112         Old_Mailbox   => $old_username,
 113         New_Mailbox   => $new_username,
 114       );
 115     }
 116
 117     #my $other = 'F';
 118     if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) {
 119       $new_password = $1;
 120     #  $other = 'T';
 121     }
 122     #cp_command($host, $port, $username, $password, $login_domain,
 123     #  'set_mailbox_status',
 124     #  Domain       => $domain,
 125     #  Mailbox      => $new_username,
 126     #  Other        => $other,
 127     #  Other_Bounce => $other,
 128     #);
 129
 130     if ( $old_password ne $new_password ) {
 131       cp_command($host, $port, $username, $password, $login_domain,
 132         'change_mailbox',
 133         Domain    => $domain,
 134         Mailbox   => $new_username,
 135         Password  => $new_password,
 136       );
 137     }
 138
 139     return;
 140   }
 141   #eof quelle hack
 142
 143   eval "use Net::APP;";
 144
 145   my $app = new Net::APP (
 146     "$host:$port",
 147     User     => $username,
 148     Password => $password,
 149     Domain   => $login_domain,
 150     Timeout  => 60,
 151     #Debug    => 1,
 152   ) or die "$@\n";
 153
 154   $app->$method( @args );
 155
 156   die $app->message."\n" unless $app->ok;
 157
 158 }
 159
 160 1;
 161