FS/FS/part_export/acct_google.pm

   1 package FS::part_export::acct_google;
   2
   3 use strict;
   4 use vars qw(%info %SIG $CACHE);
   5 use Tie::IxHash;
   6 use base 'FS::part_export';
   7
   8 tie my %options, 'Tie::IxHash',
   9   'domain'    => { label => 'Domain name' },
  10   'username'  => { label => 'Admin username' },
  11   'password'  => { label => 'Admin password' },
  12 ;
  13 # To handle multiple domains, use separate instances of
  14 # the export.  We assume that they all have different
  15 # admin logins.
  16
  17 %info = (
  18   'svc'       => 'svc_acct',
  19   'desc'      => 'Google hosted mail',
  20   'options'   => \%options,
  21   'nodomain'  => 'Y',
  22   'notes'    => <<'END'
  23 Export accounts to the Google Provisioning API.  Requires
  24 REST::Google::Apps::Provisioning from CPAN.
  25 END
  26 );
  27
  28 sub rebless { shift; }
  29
  30 sub _export_insert {
  31   my($self, $svc_acct) = (shift, shift);
  32   $svc_acct->finger =~ /^(.*)\s+(\S+)$/;
  33   my ($first, $last) = ($1, $2);
  34   $self->google_request('createUser',
  35     'username'      => $svc_acct->username,
  36     'password'      => $svc_acct->_password,
  37     'givenName'     => $first,
  38     'familyName'    => $last,
  39   );
  40 }
  41
  42 sub _export_replace {
  43   my( $self, $new, $old ) = (shift, shift, shift);
  44   # We have to do this in two steps, so do the renameUser last so that
  45   # if it fails partway through the username is still coherent.
  46   if ( $new->_password ne $old->_password
  47     or $new->finger    ne $old->finger ) {
  48     $new->finger =~ /^(.*)\s+(\S+)$/;
  49     my ($first, $last) = ($1, $2);
  50     my $error = $self->google_request('updateUser',
  51       'username'    => $old->username,
  52       'password'    => $new->_password,
  53       'givenName'   => $first,
  54       'familyName'  => $last,
  55     );
  56     return $error if $error;
  57   }
  58   if ( $new->username ne $old->username ) {
  59     my $error = $self->google_request('renameUser',
  60       'username'  => $old->username,
  61       'newname'   => $new->username
  62     );
  63     return $error if $error;
  64   }
  65   return;
  66 }
  67
  68 sub _export_delete {
  69   my( $self, $svc_acct ) = (shift, shift);
  70   $self->google_request('deleteUser',
  71     'username'  => $svc_acct->username
  72   );
  73 }
  74
  75 sub _export_suspend {
  76   my( $self, $svc_acct ) = (shift, shift);
  77   $self->google_request('updateUser',
  78     'username'  => $svc_acct->username,
  79     'suspended' => 'true',
  80   );
  81 }
  82
  83 sub _export_unsuspend {
  84   my( $self, $svc_acct ) = (shift, shift);
  85   $self->google_request('updateUser',
  86     'username'  => $svc_acct->username,
  87     'suspended' => 'false',
  88   );
  89 }
  90
  91 sub captcha_url {
  92   my $self = shift;
  93   my $google = $self->google_handle;
  94   if (exists ($google->{'captcha_url'}) ) {
  95     return 'http://www.google.com/accounts/'.$google->{'captcha_url'};
  96   }
  97   else {
  98     return '';
  99   }
 100 }
 101
 102 sub captcha_auth {
 103   my $self = shift;
 104   my $response = shift;
 105   my $google = $self->google_handle('captcha_response' => $response);
 106   return (defined($google->{'token'}));
 107 }
 108
 109 my %google_error = (
 110   1000 => 'unknown error',
 111   1001 => 'server busy',
 112   1100 => 'username belongs to a recently deleted account',
 113   1101 => 'user suspended',
 114   1200 => 'domain user limit exceeded',
 115   1201 => 'domain alias limit exceeded',
 116   1202 => 'domain suspended',
 117   1203 => 'feature not available on this domain',
 118   1300 => 'username in use',
 119   1301 => 'user not found',
 120   1302 => 'reserved username',
 121   1400 => 'illegal character in first name',
 122   1401 => 'illegal character in last name',
 123   1402 => 'invalid password',
 124   1403 => 'illegal character in username',
 125   # should be everything we need
 126 );
 127
 128 # Runs the request and returns nothing if it succeeds, or an
 129 # error message.
 130
 131 sub google_request {
 132   my ($self, $method, %opt) = @_;
 133   my $google = $self->google_handle(
 134     'captcha_response' => delete $opt{'captcha_response'}
 135   );
 136   return $google->{'error'} if $google->{'error'};
 137
 138   # Throw away the result from this; we don't use it yet.
 139   eval { $google->$method(%opt) };
 140   if ( $@ ) {
 141     return $google_error{ $@->{'error'}->{'errorCode'} } || $@->{'error'};
 142   }
 143   return;
 144 }
 145
 146 # Returns a REST::Google::Apps::Provisioning object which is hooked
 147 # to die {error => stuff} on API errors.  The cached auth token
 148 # will be used if possible.  If not, try to authenticate.  On
 149 # authentication error, the R:G:A:P object will still be returned
 150 # but with $google->{'error'} set to the error message.
 151
 152 sub google_handle {
 153   my $self = shift;
 154   my $class = 'REST::Google::Apps::Provisioning';
 155   my %opt = @_;
 156   eval "use $class";
 157
 158   die "failed to load $class\n" if $@;
 159   $CACHE ||= new Cache::FileCache( {
 160       'namespace'   => __PACKAGE__,
 161       'cache_root'  => "$FS::UID::cache_dir/cache.$FS::UID::datasrc",
 162   } );
 163   my $google = $class->new( 'domain'  => $self->option('domain') );
 164
 165   # REST::Google::Apps::Provisioning lacks error reporting.  We deal
 166   # with that by hooking HTTP::Response to throw a useful fatal error
 167   # on failure.
 168   $google->{'lwp'}->add_handler( 'response_done' =>
 169     sub {
 170       my $response = shift;
 171       return if $response->is_success;
 172
 173       my $error = '';
 174       if ( $response->content =~ /^</ ) {
 175         #presume xml
 176         $error = $google->{'xml'}->parse_string($response->content);
 177       }
 178       elsif ( $response->content =~ /=/ ) {
 179         $error = +{ map { if ( /^(\w+)=(.*)$/ ) { lc($1) => $2 } }
 180           split("\n", $response->content)
 181         };
 182       }
 183       else { # have something to say if there is no response...
 184         $error = {'error' => $response->status_line};
 185       }
 186       die $error;
 187     }
 188   );
 189
 190   my $cache_token = $self->exportnum . '_token';
 191   my $cache_captcha = $self->exportnum . '_captcha_token';
 192   $google->{'token'} = $CACHE->get($cache_token);
 193   if ( !$google->{'token'} ) {
 194     my %login = (
 195       'username' => $self->option('username'),
 196       'password' => $self->option('password'),
 197     );
 198     if ( $opt{'captcha_response'} ) {
 199       $login{'logincaptcha'} = $opt{'captcha_response'};
 200       $login{'logintoken'} = $CACHE->get($cache_captcha);
 201     }
 202     eval { $google->captcha_auth(%login); };
 203     if ( $@ ) {
 204       $google->{'error'} = $@->{'error'};
 205       $google->{'captcha_url'} = $@->{'captchaurl'};
 206       $CACHE->set($cache_captcha, $@->{'captchatoken'}, '1 minute');
 207       return $google;
 208     }
 209     $CACHE->remove($cache_captcha);
 210     $CACHE->set($cache_token, $google->{'token'}, '1 hour');
 211   }
 212   return $google;
 213 }
 214
 215 # REST::Google::Apps::Provisioning also lacks a way to do this
 216 sub REST::Google::Apps::Provisioning::captcha_auth {
 217   my $self = shift;
 218
 219   return( 1 ) if $self->{'token'};
 220
 221   my ( $arg );
 222   %{$arg} = @_;
 223
 224   map { $arg->{lc($_)} = $arg->{$_} } keys %{$arg};
 225
 226   foreach my $param ( qw/ username password / ) {
 227     $arg->{$param} || croak( "Missing required '$param' argument" );
 228   }
 229
 230   my @postargs = (
 231     'accountType' => 'HOSTED',
 232     'service'     => 'apps',
 233     'Email'       => $arg->{'username'} . '@' . $self->{'domain'},
 234     'Passwd'      => $arg->{'password'},
 235   );
 236   if ( $arg->{'logincaptcha'} ) {
 237     push @postargs,
 238       'logintoken'  => $arg->{'logintoken'},
 239       'logincaptcha'=> $arg->{'logincaptcha'}
 240       ;
 241   }
 242   my $response = $self->{'lwp'}->post(
 243     'https://www.google.com/accounts/ClientLogin',
 244     \@postargs
 245   );
 246
 247   $response->is_success() || return( 0 );
 248
 249   foreach ( split( /\n/, $response->content() ) ) {
 250     $self->{'token'} = $1 if /^Auth=(.+)$/;
 251     last if $self->{'token'};
 252   }
 253
 254   return( 1 ) if $self->{'token'} || return( 0 );
 255 }
 256
 257 1;