APP.pm

   1 package Net::APP;
   2
   3 use strict;
   4 use vars qw($VERSION $APP_VERSION @ISA $AUTOLOAD);
   5 use Carp;
   6 use IO::Socket;
   7 use Net::Cmd;
   8 #use Text::CSV_XS;
   9
  10 $VERSION = '0.2'; # $Id: APP.pm,v 1.4 2003-06-03 12:28:23 ivan Exp $
  11 $APP_VERSION = '3.3';
  12
  13 @ISA = qw(Net::Cmd IO::Socket::INET);
  14
  15 =head1 NAME
  16
  17 Net::APP - Critical Path Account Provisioning Protocol
  18
  19 =head1 SYNOPSIS
  20
  21   use Net::APP;
  22
  23   #constructor
  24   $app = new Net::APP ( 'host:port',
  25                         User     => $user,
  26                         Domain   => $domain,
  27                         Password => $password,
  28                         Timeout  => 60,
  29                         Debug    => 1,
  30                       ) or die $@;
  31
  32   #commands
  33   $app->ver( 'ver' => $Net::APP::APP_VERSION );
  34   $app->login ( User     => $user,
  35                 Domain   => $domain,
  36                 Password => $password,
  37               );
  38
  39   $app->create_domain ( Domain => $domain );
  40   $app->delete_domain ( Domain => $domain );
  41   #etc. (see the Account Provisioning Protocol Developer's Guide, section 3.3)
  42
  43   #command status
  44   $message = $app->message;
  45   $code = $app->code;
  46   $bool = $app->ok();
  47
  48   #destructor
  49   $app->close();
  50
  51 =head1 DESCRIPTION
  52
  53 This module implements a client interface to Critical Path's Account
  54 Provisioning Protocol, enabling a perl application to talk to APP servers.
  55 This documentation assumes that you are familiar with the APP protocol
  56 documented in the Account Provisioning Protocol Developer's Guide.
  57
  58 A new Net::APP object must be created with the I<new> method.  Once this has
  59 been done, all APP commands are accessed via method calls on the object.
  60
  61 =head1 METHODS
  62
  63 =over 4
  64
  65 =item new ( HOST:PORT [ , OPTIONS ] )
  66
  67 This is the constructor for a new Net::APP object.  C<HOST> and C<PORT>
  68 specify the host and port to connect to in cleartext.  Typically this
  69 connection is proxied via Safe Passage Secure Tunnel or Stunnel
  70 http://www.stunnel.org/ using a command such as:
  71
  72  stunnel -c -P none -c -d 8888 -r your.cp.address.and:port
  73
  74 This method will connect to the APP server and execute the I<ver> method.
  75
  76 I<OPTIONS> are passed in a hash like fastion, using key and value pairs.
  77 Possible options are:
  78
  79 I<Timeout> - Set a timeout value (defaults to 120)
  80
  81 I<Debug> - Enable debugging information (see the debug method in L<Net::Cmd>)
  82
  83 I<User>, I<Domain>, I<Password> - if these exist, the I<new> method will also
  84 execute the I<login> method automatically.
  85
  86 If the constructor fails I<undef> will be returned and an error message will be
  87 in $@.
  88
  89 =cut
  90
  91 sub new {
  92   my $proto = shift;
  93   my $class = ref($proto) || $proto;
  94   my ($host, $port) = split(/:/, shift);
  95   my %arg = @_;
  96
  97   my $self = $class->SUPER::new( PeerAddr => $host,
  98                                 PeerPort => $port,
  99                                 Proto    => 'tcp',
 100                                 Timeout  => defined $arg{Timeout}
 101                                                     ? $arg{Timeout}
 102                                                     : 120
 103                               ) or return undef;
 104
 105   $self->autoflush(1);
 106
 107   $self->debug(exists $arg{Debug} ? $arg{Debug} : undef);
 108
 109   my $response = $self->_app_response;
 110   unless ( $self->message =~ /^HI APP/ ) {
 111     $@ = $self->code. " ". $self->message;
 112     $self->close();
 113     return undef;
 114   }
 115
 116   $self->ver( 'ver' => $APP_VERSION );
 117   unless ( $self->ok ) {
 118     $@ = $self->code. " ". $self->message;
 119     $self->close();
 120     return undef;
 121   }
 122
 123   if ( exists $arg{User} && exists $arg{Domain} && exists $arg{Password} ) {
 124     $self->login( User     => $arg{User},
 125                   Domain   => $arg{Domain},
 126                   Password => $arg{Password},
 127                 );
 128     unless ( $self->ok ) {
 129       $@ = $self->code. " ". $self->message;
 130       $self->close();
 131       return undef;
 132     }
 133   }
 134
 135   $self;
 136 }
 137
 138 =item ver
 139
 140 =item login
 141
 142 =item create_domain
 143
 144 =item delete_domain
 145
 146 =item etc.
 147
 148 See the Account Provisioning Protocol Developer's Guide for details.  Commands
 149 need not be in upper case, and options are passed in a hash-like fashion, as
 150 a list of key-value pairs.
 151
 152 Unless noted below, all commands return a reference to a list containing the
 153 lines of the reponse, or I<undef> upon failure.  The first line is parsed for
 154 the status code and message.  You can check the status code and message using
 155 the normal Net::Cmd I<message>, I<code>, I<ok>, and I<status> methods.
 156
 157 Some methods return additional response information, such as
 158 get_num_domain_mailboxes, get_domain_mailboxes, get_mailbox_availability and
 159 get_mailbox_status methods currently return any additional response
 160 information.  Unless specifically noted below, no attempt is (yet) made to
 161 parse this data.
 162
 163 =item get_domain_mailboxes
 164
 165 Returns an arrayref of arrayrefs, each with three elements: username, mailbox
 166 type, and workgroup.  The protocol calls them: MAILBOX, TYPE, and WORKGROUP.
 167
 168 =cut
 169
 170 sub get_domain_mailboxes {
 171   my $self = shift;
 172 #  my $command = $AUTOLOAD;
 173 #  $command =~ s/.*://;
 174   my $command = 'get_domain_mailboxes';
 175 #  my $csv = new Text::CSV_XS;
 176   $self->_app_command( $command, @_ );
 177   [ map { chomp; [ map { s/(^"|"$)//g; $_ }
 178                        split(/(?<=[^"]")\s+(?="[^"])/, $_)
 179                  ]
 180         }
 181         grep { $_ !~ /^,$/ }
 182              splice( @{$self->_app_response}, 2 )
 183   ];
 184 }
 185
 186 =item get_mailbox_forward_only
 187
 188 Returns the forward email address.
 189
 190 =cut
 191
 192 sub get_mailbox_forward_only {
 193   my $self = shift;
 194 #  my $command = $AUTOLOAD;
 195 #  $command =~ s/.*://;
 196   my $command = 'get_mailbox_forward_only';
 197   $self->_app_command( $command, @_ );
 198
 199   my $lines = $self->_app_response;
 200
 201   unless ( $lines->[1] =~ /^FORWARD_EMAIL="([^"]+)"$/ ) {
 202     warn $lines->[1];
 203     $self->set_status ( -1, $lines->[0] );
 204     return undef;
 205   }
 206
 207   $1;
 208
 209 }
 210
 211 =item message
 212
 213 Returns the text message returned from the last command.
 214
 215 =item code
 216
 217 Returns the response code from the last command (see the Account Provisioning
 218 Protcol Developer's Guide, chapter 4).  The code `-1' is used to represent
 219 unparsable output from the APP server, in which case the entire first line
 220 of the response is returned by the I<messsage> method.
 221
 222 =item ok
 223
 224 Returns true if the last response code was not an error.  Since the only
 225 non-error code is 0, this is just the negation of the code method.
 226
 227 =cut
 228
 229 sub ok {
 230   my $self = shift;
 231   ! $self->code();
 232 }
 233
 234 =item status
 235
 236 Since the APP protocol has no concept of a "most significant digit" (see
 237 L<Net::Cmd/status>), this is a noisy synonym for I<code>.
 238
 239 =cut
 240
 241 sub status {
 242   carp "status method called (use code instead)";
 243   my $self = shift;
 244   $self->code();
 245 }
 246
 247 sub AUTOLOAD {
 248   my $self = shift;
 249   my $command = $AUTOLOAD;
 250   $command =~ s/.*://;
 251   $self->_app_command( $command, @_ );
 252   $self->_app_response;
 253 }
 254
 255 =back
 256
 257 =head1 INTERNAL METHODS
 258
 259 These methods are not intended to be called by the user.
 260
 261 =over 4
 262
 263 =item _app_command ( COMMAND [ , OPTIONS ] )
 264
 265 Sends I<COMMAND>, encoded as per the Account Provisioning Protocol Developer's
 266 Guide, section 3.2.  I<OPTIONS> are passed in a hash like
 267 fashion, using key and value pairs.
 268
 269 =cut
 270
 271 sub _app_command {
 272   my $self = shift;
 273   my $command = shift;
 274   my %arg = @_;
 275
 276   $self->command ( uc($command),
 277                    map "\U$_\E=\"". _quote($arg{$_}). '"', keys %arg
 278                  );
 279   $self->command( '.' );
 280 }
 281
 282 =item _app_response
 283
 284 Gets a response from the server.  Returns a reference to a list containing
 285 the lines, or I<undef> upon failure.  You can check the status code and message
 286 using the normal Net::Cmd I<message>, I<code>, I<ok>, and I<status> methods.
 287
 288 =cut
 289
 290 sub _app_response {
 291   my $self = shift;
 292   my $lines = $self->read_until_dot;
 293   if ( $self->debug ) {
 294     foreach ( @{$lines}, ".\n" ) { $self->debug_print('', $_ ) }
 295   }
 296   if ( $lines->[0] =~ /^(OK|ER)\s+(\d+)\s+(.*)$/ ) {
 297     warn 'OK response with non-zero status!' if $1 eq 'OK' && $2;
 298     warn 'ER response with zero status!' if $1 eq 'ER' && ! $2;
 299     $self->set_status ( $2, $3 );
 300   } else {
 301     $self->set_status ( -1, $lines->[0] );
 302   }
 303   $lines;
 304 }
 305
 306 =back
 307
 308 =head1 INTERNAL SUBROUTINES
 309
 310 These subroutines are not intended to be called by the user.
 311
 312 =over 4
 313
 314 =item _quote
 315
 316 Doubles double quotes.
 317
 318 =cut
 319
 320 sub _quote {
 321   my $string = shift;
 322   $string =~ s/\"/\"\"/g; #consecutive quotes?
 323   $string;
 324 }
 325
 326 =back
 327
 328 =head1 AUTHOR
 329
 330 Ivan Kohler <ivan-netapp_pod@420.am>.
 331
 332 This module is not sponsored or endorsed by Critical Path.
 333
 334 =head1 COPYRIGHT
 335
 336 Copyright (c) 2001 Ivan Kohler.
 337 All rights reserved.
 338 This program is free software; you can redistribute it and/or modify it under
 339 the same terms as Perl itself.
 340
 341 =head1 PROTOCOL VERSION
 342
 343 This module currently implements APP v3.3, as documented in the Account
 344 Provisioning Protocol Developers Guide v3.3.
 345
 346 =head1 BUGS
 347
 348 The Account Provisioning Protocol Developer's Guide is not publicly available.
 349
 350 It appears that Safe Passage Secure Tunnel and Stunnel establish standard SSL
 351 connections.  It should be possible to use Net::SSLeay and connect to the APP
 352 server directly.  Initial prototyping with IO::Socket::SSL was not promising. :(
 353
 354 The get_num_domain_mailboxes, get_mailbox_availability and get_mailbox_status
 355 methods currently return response information.  No attempt is (yet) made to
 356 parse this data.
 357
 358 =head1 SEE ALSO
 359
 360 Critical Path <http://www.cp.net/>,
 361 APP documentation <http://support.cp.net/products/email_messaging/documentation/index.jsp>,
 362 Safe Passage Secure Tunnel <http://www.int.c2.net/external/?link=spst/index.php3>,
 363 Stunnel <http://www.stunnel.org>,
 364 L<IO::Socket>, L<Net::Cmd>, perl(1).
 365
 366 =cut
 367
 368 1;
 369