Ph - provide a perl API for talking to CSO ph servers.

Ph documentation Contained in the Ph distribution.

Index

Code Index:

NAME

Top

Ph -- provide a perl API for talking to CSO ph servers.

SYNOPSIS

Top

    use Ph;

NOTICE

Top

This version of Ph.pm is not compatbile with pre-2.0 versions. Users of older versions (primarily at QUALCOMM) will need to convert their scripts to be compatible with this version of Ph.pm. (This was done to make Ph.pm more object-oriented, allowing multiple connections at once.)

DESCRIPTION

Top

The Ph module provides a uniform API for perl scripts that need to talk to CSO ph servers. It handles many of the messy details automatically. It also maintains an open connection to the server, minimizing the costs of repeated openings and closings of server connections (and the associated costs on the server of repeatedly forking off short-lived processes to service requests made by the client.)

In order to use the Ph protocol module, you will need to have the IO::Socket support and associated perl modules installed. You wil also need to use perl 5.003 or later. (See perl.) You should already be familiar with perl data structures and perl references. If not, read perldata and perlref.

It is assumed that you are already familiar with the ph protocol. If you are not, please read The CCSO Nameserver Server-Client Protocol by Steven Dorner and Paul Pomes. It contains all of the descriptions of the various ph requests that one can make. (This API does simplify the problems associated with parsing server responses.)

CONSTRUCTOR

Top

new ( [ARGS])

The constructor takes a number of arguments.

PhServer: Remote Ph server name (default is 'ns').

PhPort: Remove Ph port (default is 'ns', or '105').

Debug: If set, module debugging is enabled.

GLOBALS

Top

$DefaultPhPort

This constant value is the default port to make connections on if one is not specified as an argument to Connect. Its default value is the value assigned to 'ns' in /etc/services, or 105.

$DefaultPhServer

The default ph server to use if not specified in the arguments to Connect. This defaults to 'ns'.

METHODS

Top

The following methods are provided as part of the API.

Add ENTRY

This is a request to create a new ph record. The record has fields with values specified by ENTRY, which can be either a reference to an associative array, or it may just be a string itself. Hero login status is required. A boolean return indicates whether the change was successful or not.

Change QUERY CHANGES

This is a request to modify existing ph record(s). The QUERY is a reference to an associative array, or a query string (Exactly as for the Query subroutine.) The CHANGES is another reference to an associative array (or scalar string), containing the field names to be changed, and the new values that they are to hold. The value returned is the ph result code returned by the server. NOTE: Fields that are Encrypted (e.g. password) cannot be changed, yet! I will implement this as soon as I better understand how the encryption works. The return value is a boolean variable indicating whether or not the change was successful.

Connect SERVER PORT

This is a request to establish a connection to a ph server. In addition, several other requests are sent to the server. They are id, siteinfo, and fields. The returned values are stored in variables for use later. Only one connection to a server can be active within a perl program at any one time. Returns truth on success, false on failure.

Delete ENTRY

This deletes an entire record from the ph server. The record is selected by the query matching ENTRY, which is either a reference to an associative array, or a string query specification. The value returned is the result code returned by the ph server. USE WITH CAUTION! Hero mode is required. Returns true of false to indicate successful or failed results.

Disconnect

This disconnects from the server. It sends the quit request before closing, to be polite to the server. This is also called automatically by the package destructor, if necessary. No return value is used.

ErrorMessage CODE

This returns a string representation of the message associated with the result code returned by the server.

Fields

Returns an associative array containing the field attributes for the fields defined by the currently connected ph server. The keys are the field names, and the values are references to an attribute description hash:

    name	the field name
    max		the maximum length of the field
    desc	textual description for the field
    *		other flags (e.g. Default, Lookup, Public) for the field
GetLastCode

This returns the last positive result code returned by the Ph server.

GetLastMessage

This returns the last message returned by the Ph server. This can be useful in determining the cause of failure -- it sometimes provides more detail than is possible with just the GetLastCode value.

IsConnected

This returns a boolean value which indicates whether or not an active connection to a server has been established.

Login ALIAS PASSWORD

This request logs into the server, if possible. It should use the answer method rather than the less secure clear method to encrypt the response. Unfortunately, the cryptit.c file included with the ph distribution is incredibly, well, cryptic! I am not exactly sure what it is doing, and converting it to perl is proving tiresome. (I have been told that the encryption is based upon a 3-rotor enigma. If anyone is feeling ambitious enough to provide a perl equivalent, I would be happy to fix this routine.) A truth value is returned to the caller to indicate whether the login succeeded or not.

Logout

Simply put, logout of the ph server! (Obviously, you must be logged in first!) CAUTION: There is a serious bug in some Ph servers which prevents the logout action from removing any privileges. A hero mode session that has been logged out can still destroy the database (accidentally or on purpose). This was discovered the hard way by the author of this package, who had to reenter his entire ph record by hand after running over this bug!

Query QUERY FIELDS

This sends a query to the ph server and builds an array containing references to associative arrays. These associative arrays correspond to matching records, with each field of the match represented by a key in the associative array. QUERY should be a reference to an associative array containing the fields to query for. Alternatively, it can be a string of the form "field=value ...".

FIELDS is reference to an array containing the names of the fields to return. If you want to return all fields, just specify the word "all". Otherwise, only default fields provided by the server returned. Note that the ph server may enforce certain restrictions about what fields you can view.

The returned value will be an array filled with references to associative arrays. For example, to obtain the phone number of the first person named "Garrett" into $phone, you might try this:

	@matches = $Ph->Query("name=garrett", "phone");
	$phone = $matches[0]->{phone};
SiteInfo

Returns an associative array containing the results of the siteinfo ph request for the currently connected server. Each key corresponds to a field name in the returned result.

Version

This function is used merely to determine the RCS revision number of the module that you are using. Newer versions may be posted from time to time, and this allows you to determine if you are using the latest version of the Ph module.

AUTHOR

Top

This module was written entirely in perl by Garrett D'Amore. It is Copyright 1995, Qualcomm, Inc. You can reach the author at the e-mail address garrett@qualcomm.com.

Ph documentation Contained in the Ph distribution. 
#
# Ph.pm - a module for talking to CCSO Ph servers
#
# Copyright 1995-1998, Garrett D'Amore. <garrett@yavin.org>
# See the Artistic License for licensing details and use
# agreements.
#
# Important: READ THE Artistic FILE -- it limits my liability
# and provids the specific agreements to which you must agree
# if you use this package.
#
package Ph;

use strict;
use vars qw($VERSION $DefaultPhPort $DefaultPhServer @ISA);

$VERSION = '2.01';
@ISA = qw();

require 5.003;

use IO::Socket;
use Carp;

$DefaultPhPort = "ns(105)";
$DefaultPhServer = "ns";

sub new
{
    my ($class, %arg) = @_;
    return bless \%arg, $class;
}

sub Add
{
    my $self = shift;
    my $entry = shift;
    my $request = "add";

    $request .= $self->_MakeFieldsLine($entry);
    $self->_SendRequest($request);

    return $self->_IsSuccessful($self->_GetCode());
}

sub Change
{
    my $self = shift;
    my ($query,$changes) = @_;
    my $request = "change ";

    $request .= $self->_MakeFieldsLine($query);
    $request .= " make";
    $request .= $self->_MakeFieldsLine($changes);

    $self->_SendRequest($request);

    return $self->_IsSuccessful($self->_GetCode());
}

sub Connect
{
    my $self = shift;
    my $code;
    my ($PhServer, $PhPort) = @_;
    if (!defined $PhServer)
    {
	$PhServer = $DefaultPhServer;
    }
    if (!defined $PhPort)
    {
	$PhPort = $DefaultPhPort;
    }

    my $sock = IO::Socket::INET->new(PeerAddr	=> $PhServer,
				     PeerPort	=> $PhPort,
				     Proto	=> 'tcp');

    if (!defined $sock)
    {
	$self->{last_message} = $@;
	$self->{last_message} =~ s/^IO::Socket::INET/connect/;
	$self->{last_code} = 998;
	return 0;
    }

    # make socket unbuffered, this is the default under 5.004_04
    $sock->autoflush;
    $self->{sock} = $sock;

    # send id -- we send our UNIX account name -- this is not
    # strictly required but it is polite
    $self->_SendRequest("id $<"); 
    $code = $self->_GetCode();

    if (!$self->_IsSuccessful($code))
    {
	return 0;
    }

    # get the database status
    $self->_SendRequest("status");
    return $self->_IsSuccessful($self->_GetCode());
}

sub Delete
{
    my $self	= shift;
    my $entry	= shift;
    my $request = "delete";

    $request .= $self->_MakeFieldsLine($entry);
    $self->_SendRequest($request);

    return $self->_IsSuccessful($self->_GetCode());
}

sub Disconnect
{
    my $self = shift;
    my $code;
    if (defined $self->{sock})
    {
	$self->_SendRequest("quit");
	# we don't care about the value, we just throw it away
	$self->_GetCode();
	close($self->{sock});
	delete $self->{sock};
    }
}

sub ErrorMessage
{
    my $self = shift;
    my $code = shift;

    my %messages =  (
	100	=>     'In progress (general).',
	101	=>     'Echo of current command.',
	102	=>     'Count of number of matches to query.',
	200	=>     'Success (general).',
	201	=>     'Database ready, but read only.',
	300	=>     'More information (general).',
	301	=>     'Encrypt this string.',
	400	=>     'Temporary error (general).',
	401	=>     'Internal database error.',
	402	=>     'Lock not obtained within timeout period.',
	475	=>     'Database unavailable; try later.',
	500	=>     'Permanent error (general).',
	501	=>     'No matches to query.',
	502	=>     'Too many matches to query.',
	503	=>     'Not authorized for requested information.',
	504	=>     'Not authorized for requested search criteria.',
	505	=>     'Not authorized to change requested field.',
	506	=>     'Request refused; must be logged in to execute.',
	507	=>     'Field does not exist.',
	508	=>     'Field is not present in requested entry.',
	509	=>     'Alias already in use.',
	510	=>     'Not authorized to change this entry.',
	511	=>     'Not authorized to add entries.',
	512	=>     'Illegal value.',
	513	=>     'Unknown option.',
	514	=>     'Unknown command.',
	515	=>     'No indexed field in query.',
	516	=>     'No authorization for request.',
	517	=>     'Operation failed because database is read only.',
	518	=>     'Too many entries selected by change command.',
	520	=>     'CPU usage limit exceeded.',
	521	=>     'Change command would have overridden existing field, and the "addonly" option is on.',
	522	=>     'Attempt to view "Encrypted" field.',
	523	=>     'Expecting "answer" or "clear"',
	524	=>     'Names of help topics may not contain "/".',
	598	=>     'Command unknown.',
	599	=>     'Syntax error.',
        995	=>     '[socket failure]',
        996	=>     '[bind failure]',
	997     =>     '[unknown host]',
        998	=>     '[connection failure]',
	999	=>     '[connection closed]'
	);
    return $messages{$code};
}

sub Fields
{
    my $self = shift;
    my %result = ();
    my $name;
    my $code;

    # get the field descriptions
    $self->_SendRequest("fields");
    do
    {
	my @response = $self->_ParseResponse($self->_GetResponse());
	$code = $response[0];
	$name = $response[2];
	# second line is just the description
	if (defined $result{$name})
	{
	    $result{$name}->{desc} = $response[3];
	}
	# first line contains the good stuff
	else
	{
	    my $flag;
	    my @flags = split(/\s+/, $response[3]);

	    $result{$name} = {};
	    $result{$name}->{number} = $response[1];
	    $result{$name}->{name} = $name;

	    foreach $flag (@flags)
	    {
		if ($flag =~ /^\d+$/)
		{
		    $result{$name}->{max} = $flag;
		}
		elsif ($flag eq 'max')
		{
		    # nop
		}
		else
		{
		    $result{$name}->{$flag} = $flag;
		}
	    } # foreach $flag
	} # defined $result{$name}, i.e. end of field description
    } while ($code < 200);
    return ($self->_IsSuccessful($code)) ? %result : undef;
}

sub _IsSuccessful
{
    my $self = shift;
    my $code = shift;
    return (int($code / 100) == 2);
}

sub _GetCode
{
    my $self = shift;
    my $code;
    do
    {
	my @result = $self->_ParseResponse($self->_GetResponse());
	$code = $result[0];
    } while ($code < 200);
    return $code;
}

sub _GetResponse
{
    my $self = shift;
    my $sock = $self->{sock};
    my $response;

    if (!defined $sock)
    {
	$response="999: [no active connection]\n";
    }
    else 
    {
	$response = $sock->getline();
    }

    if (!defined $response)
    {
	$response="999: [connection closed]\n";
	delete $self->{sock};
    }
    chomp $response;
    print STDERR "server> $response\n" if ($self->{Debug});
    return $response;
}

sub GetLastCode
{
    my $self = shift;
    return $self->{last_code};
}

sub GetLastMessage
{
    my $self = shift;
    return $self->{last_message};
}

sub IsConnected
{
    my $self = shift;
    return defined($self->{sock});
}

sub Login
{
    my $self = shift;
    my ($alias, $password) = @_;
    my ($code, $challenge, $answer);

    $self->_SendRequest("login $alias");

    $code = $self->_GetCode();

    # abort if we were not challenged!
    return 0 if $code != 301;

    #
    # unfortunately, I don't know how to answer the challenge
    # Dorner's code is *very* hard to understand!  But if we
    # ever figure it out, here's where we'll put the challenge
    # response.
    #

    # so for now we send the password in the clear (blech!)
    $self->_SendRequest("clear $password");

    # overwrite password to minimize exposure; not sure if
    # this really helps with perl
    $password = "xxxxxxxxxxxxxx";  

    return $self->_IsSuccessful($self->_GetCode());
}

sub Logout
{
    my $self = shift;
    
    $self->_SendRequest("logout");
    return $self->_IsSuccessful($self->_GetCode());
}

sub _MakeFieldsLine
{
    my $self	= shift;
    my $fields	= shift;
    my ($output, $field);

    $output = "";

    if (ref($fields) eq 'HASH')
    {
	foreach $field (keys %$fields)
	{
	    $fields->{$field} =~ s/"/\\"/;
	    $output .= " $field=\"$fields->{$field}\"";
	}
    }
    elsif (ref($fields) eq 'ARRAY')
    {
	foreach $field (@$fields)
	{
	    $output .= " $field";
	}
    }
    else
    {
	$output = " $fields";
    }
    return $output;
}

sub _ParseResponse
{
    my $self = shift;
    my $unparsed = shift;
    my @parsed = split(/: */, $unparsed, 4);
    $self->{last_code} = $parsed[0];
    $self->{last_message} = $parsed[1];
    return @parsed;
}

sub Query
{
    my $self = shift;
    my ($query, $fieldlist) = @_;
    my ($key, $request, $index, @response, $lastfield, $code, $field, $value);
    my @matches = ();

    $index = 0;

    $request = "query";
    $request .= $self->_MakeFieldsLine($query);
    if (defined ($fieldlist))
    {
	$request .= " return";
        $request .= $self->_MakeFieldsLine($fieldlist);
    }
    $self->_SendRequest($request);

    do
    {
	@response = ();
	@response = $self->_ParseResponse($self->_GetResponse());
        $code = $response[0];
        if (defined $response[3])
	{
	    $index = $response[1] - 1;
	    $field = length($response[2]) ? $response[2] : $lastfield;
	    $lastfield = $field;
	    $value = $response[3];

	    if (!defined $matches[$index])
	    {
		$matches[$index] = { };
	    }	

	    if (!defined $matches[$index]->{$field} )
	    {
		$matches[$index]->{$field} = '';
	    }
	    else
	    {
		$matches[$index]->{$field} .= "\n";
	    }

	    $matches[$index]->{$field} .= $value;
	}
    } while ($code < 200);
    return $self->_IsSuccessful($code) ? @matches : undef;
}

sub _SendRequest
{
    my $self = shift;
    my $request = shift;
    my $sock = $self->{sock};
    if (!defined $sock)
    {
	print STDERR "client> [connection not open]\n" if $self->{Debug};
    }
    elsif (print $sock "$request\r\n")
    {
    	print STDERR "client> $request\n" if $self->{Debug};
    }
    else
    {
	print STDERR "client> [connection closed]\n" if $self->{Debug};
	delete $self->{sock};
    }
}

sub SiteInfo
{
    my $self = shift;
    my %results;
    my $code;
    $self->_SendRequest("siteinfo");
    do
    {
	my @response = $self->_ParseResponse($self->_GetResponse());
	if ($response[2])
        {
	    $results{$response[2]} = $response[3];
	}
	$code = $response[0];
    } while ($code < 200);

    return $self->_IsSuccessful($code) ? %results : undef;
}

sub Version
{
    return $VERSION;
}
1;

__END__


# Undocumented internals:
# =item _GetCode
#
# Suck in all result lines until a result code >= 200 is returned.
# (Lines that have continuations are negative values.)  Returns the
# final result code.
#
# =item _MakeFieldsLine FIELDS
#
# This takes a B<reference> to an associative array and returns a string
# of the form " field=value ..." based upon the data in the associative
# array.  If it is passed scalar, it returns the scalar unmodified.
# This subroutine is used to simplify building of query specifications
# from associative arrays, and is primarily intended for internal use.
#
# =item _ParseResponse RESPONSE
# 
# This parses the value returned by C<GetResponse> into an array.  The
# array is built as ( code sub-code field-name field-value ).  Note that
# not all elements will be defined for some responses.  This is an
# intermediate access method, and its direct use in user scripts is not
# recommened.
# 
# =item _SendRequest PH_REQUEST
# 
# This sends a ph request to the server.  PH_REQUEST should be string
# (without any terminating newlines or carriage returns) to send to the
# server.  This provides a low-level way to send protocol to the server.
# Its direct use is not recommended.
# 
# =item _GetResponse
# 
# This reads a single line of text from the server (presumably a server
# response) and returns it.  This provides a low-level access method to
# the Ph server, and its use is not recommended.  It may have to be
# called many times to retrieve all returned lines from the server for a
# single request.  Failure to do this will confuse subsequent
# transactions.
#