From ff7f79072d14341d7427e12351d56d027d92f589 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 21 Jun 1999 10:11:11 +0000 Subject: [PATCH 1/1] new project --- APP.pm | 326 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Changes | 5 + MANIFEST | 6 ++ Makefile.PL | 9 ++ README | 29 ++++++ test.pl | 73 ++++++++++++++ 6 files changed, 448 insertions(+) create mode 100644 APP.pm create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 test.pl diff --git a/APP.pm b/APP.pm new file mode 100644 index 0000000..aaa3797 --- /dev/null +++ b/APP.pm @@ -0,0 +1,326 @@ +package Net::APP; + +use strict; +use vars qw($VERSION $APP_VERSION @ISA $AUTOLOAD); +use Carp; +use IO::Socket; +use Net::Cmd; + +$VERSION = '0.1'; # $Id: APP.pm,v 1.1 1999-06-21 10:11:11 ivan Exp $ +$APP_VERSION = '2.1'; + +@ISA = qw(Net::Cmd IO::Socket::INET); + +=head1 NAME + +Net::APP - Critical Path Account Provisioning Protocol + +=head1 SYNOPSIS + + use Net::APP; + + #constructor + $app = new Net::APP ( 'host:port', + User => $user, + Domain => $domain, + Password => $password, + Timeout => 60, + Debug => 1, + ) or die $@; + + #commands + $app->ver( 'ver' => $Net::APP::APP_VERSION ); + $app->login ( User => $user, + Domain => $domain, + Password => $password, + ); + + $app->create_domain ( Domain => $domain ); + $app->delete_domain ( Domain => $domain ); + #etc. (see the Account Provisioning Protocol Developer's Guide, section 3.3) + + #command status + $message = $app->message; + $code = $app->code; + $bool = $app->ok(); + + #destructor + $app->close(); + +=head1 DESCRIPTION + +This module implements a client interface to Critical Path's Account +Provisioning Protocol, enabling a perl application to talk to APP servers. +This documentation assumes that you are familiar with the APP protocol +documented in the Account Provisioning Protocol Developer's Guide. + +A new Net::APP object must be created with the I method. Once this has +been done, all APP commands are accessed via method calls on the object. + +=head1 METHODS + +=over 4 + +=item new ( HOST:PORT [ , OPTIONS ] ) + +This is the constructor for a new Net::APP object. C and C +specify the host and port to connect to in cleartext. Typically this +connection is proxied via Safe Passage Secure Tunnel to Critical Path. + +This method will connect to the APP server and execute the I method. + +I are passed in a hash like fastion, using key and value pairs. +Possible options are: + +I - Set a timeout value (defaults to 120) + +I - Enable debugging information (see the debug method in L) + +I, I, I - if these exist, the I method will also +execute the I method automatically. + +If the constructor fails I will be returned and an error message will be +in $@. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my ($host, $port) = split(/:/, shift); + my %arg = @_; + + my $self = $class->SUPER::new( PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => defined $arg{Timeout} + ? $arg{Timeout} + : 120 + ) or return undef; + + $self->autoflush(1); + + $self->debug(exists $arg{Debug} ? $arg{Debug} : undef); + + my $response = $self->_app_response; + unless ( $self->message =~ /^HI APP/ ) { + $@ = $self->code. " ". $self->message; + $self->close(); + return undef; + } + + $self->ver( 'ver' => $APP_VERSION ); + unless ( $self->ok ) { + $@ = $self->code. " ". $self->message; + $self->close(); + return undef; + } + + if ( exists $arg{User} && exists $arg{Domain} && exists $arg{Password} ) { + $self->login( User => $arg{User}, + Domain => $arg{Domain}, + Password => $arg{Password}, + ); + unless ( $self->ok ) { + $@ = $self->code. " ". $self->message; + $self->close(); + return undef; + } + } + + $self; +} + +=item ver + +=item login + +=item create_domain + +=item delete_domain + +=item etc. + +See the Account Provisioning Protocol Developer's Guide for details. Commands +need not be in upper case, and options are passed in a hash-like fashion, as +a list of key-value pairs. + +All options return a reference to a list containing the lines of the reponse, +or I upon failure. The first line is parsed for the status code and +message. You can check the status code and message using the normal Net::Cmd +I, I, I, and I methods. + +Only the get_num_domain_mailboxes, get_mailbox_availability and +get_mailbox_status methods currently return any additional response +information. No attempt is (yet) made to parse this data. + +=item message + +Returns the text message returned from the last command. + +=item code + +Returns the response code from the last command (see the Account Provisioning +Protcol Developer's Guide, chapter 4). The code `-1' is used to represent +unparsable output from the APP server, in which case the entire first line +of the response is returned by the I method. + +=item ok + +Returns true if the last code was an acceptable response. + +=cut + +sub ok { + my $self = shift; + ! $self->code(); +} + +=item status + +Since the APP protocol has no concept of a "most significant digit" (see +L), this is a noisy synonym for I. + +=cut + +sub status { + carp "status method called (use code instead)"; + my $self = shift; + $self->code(); +} + +sub AUTOLOAD { + my $self = shift; + my $command = $AUTOLOAD; + $command =~ s/.*://; + $self->_app_command( $command, @_ ); + $self->_app_response; +} + +=back + +=head1 INTERNAL METHODS + +These methods are not intended to be called by the user. + +=over 4 + +=item _app_command ( COMMAND [ , OPTIONS ] ) + +Sends I, encoded as per the Account Provisioning Protocol Developer's +Guide, section 3.2. I are passed in a hash like +fashion, using key and value pairs. + +=cut + +sub _app_command { + my $self = shift; + my $command = shift; + my %arg = @_; + + $self->command ( uc($command), + map "\U$_\E=\"". _quote($arg{$_}). '"', keys %arg + ); + $self->command( '.' ); +} + +=item _app_response + +Gets a response from the server. Returns a reference to a list containing +the lines, or I upon failure. You can check the status code and message +using the normal Net::Cmd I, I, I, and I methods. + +=cut + +sub _app_response { + my $self = shift; + my $lines = $self->read_until_dot; + if ( $self->debug ) { + foreach ( @{$lines}, ".\n" ) { $self->debug_print('', $_ ) } + } + if ( $lines->[0] =~ /^(OK|ER)\s+(\d+)\s+(.*)$/ ) { + warn 'OK response with non-zero status!' if $1 eq 'OK' && $2; + warn 'ER response with zero status!' if $1 eq 'ER' && ! $2; + $self->set_status ( $2, $3 ); + } else { + $self->set_status ( -1, $lines->[0] ); + } + $lines; +} + +=back + +=head1 INTERNAL SUBROUTINES + +These subroutines are not intended to be called by the user. + +=over 4 + +=item _quote + +Doubles double quotes. + +This is untested for strings containing consecutive double quotes. + +=cut + +sub _quote { + my $string = shift; + $string =~ s/\"/\"\"/g; #consecutive quotes? + $string; +} + +=back + +=head1 AUTHOR + +Ivan Kohler . + +This module is not sponsored or endorsed by Critical Path. + +=head1 COPYRIGHT + +Copyright (c) 1999 Ivan Kohler. +Copyright (c) 1999 Silicon Interactive Software Design. +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 VERSION + +$Id: APP.pm,v 1.1 1999-06-21 10:11:11 ivan Exp $ + +This module currently implements APP v2.1, as documented in the Account +Provisioning Protocol Developers Guide v2.1. + +=head1 BUGS + +The Account Provisioning Protocol Developer's Guide is not publicly available. + +It appears that Safe Passage Secure Tunnel establishes a standard SSL +connection. It should be possible to use Net::SSLeay and connect to the APP +server directly. + +Sending values with consecutive double quote characters is untested. + +The get_num_domain_mailboxes, get_mailbox_availability and get_mailbox_status +methods currently return response information. No attempt is (yet) made to +parse this data. + +=head1 SEE ALSO + +Critical Path , +Safe Passage Secure Tunnel , +L, L, perl(1). + +=head1 HISTORY + +$Log: APP.pm,v $ +Revision 1.1 1999-06-21 10:11:11 ivan +Initial revision + + +=cut + +1; + diff --git a/Changes b/Changes new file mode 100644 index 0000000..41aa4f8 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension Net::APP. + +0.1 Sun Jun 20 23:15:58 1999 + - original version; created by h2xs 1.19 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..4a69a6f --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +APP.pm +Changes +MANIFEST +Makefile.PL +test.pl +README diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..eaf6a10 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Net::APP', + 'VERSION_FROM' => 'APP.pm', # finds $VERSION + 'PREREQ_PM' => { 'Net::Cmd' => 0, }, + 'dist' => {}, +); diff --git a/README b/README new file mode 100644 index 0000000..2c88670 --- /dev/null +++ b/README @@ -0,0 +1,29 @@ +Net::APP v0.1 + +Copyright (c) 1999 Ivan Kohler. +Copyright (c) 1999 Silicon Interactive Software Design. +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +This module implements a client interface to Critical Path's + Account Provisioning Protocol, enabling a perl application +to talk to APP servers. + +This module is not sponsored or endorsed by Critical Path. + +To install: + perl Makefile.PL + make + make test # nothing substantial yet + make install + +Documentation will then be available via `man Net:APP' or `perldoc Net::APP' + +A mailing list for users and developers is available. Send a blank message to + to subscribe. + +Ivan Kohler +20 4,16 * * * saytime + +$Id: README,v 1.1 1999-06-21 10:11:11 ivan Exp $ diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..aaa3715 --- /dev/null +++ b/test.pl @@ -0,0 +1,73 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..9\n"; } +END {print "not ok 1\n" unless $loaded;} +use Net::APP; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + +sub test { + local($^W) = 0; + my($num, $true,$msg) = @_; + print($true ? "ok $num\n" : "not ok $num: $msg $@\n"); +} + +sub input { + my $prompt = shift; + print $prompt; + chomp ( my $input = scalar() ); + $input; +} + +print < 1, + ); +test 3, $app->login( User => $user, + Domain => $domain, + Password => $password, + ); +test 4, $app->code == 0; +test 5, $app->quit; +test 6, $app->code == 0; +$app->close(); +undef $app; +test 6, $app = new Net::APP ( "$hostname:$port", + Debug => 1, + User => $user, + Domain => $domain, + Password => $password, + ); +test 7, $app->code == 0; +test 8, $app->quit; +test 9, $app->code == 0; +$app->close(); +undef $app; + + -- 2.11.0