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