head	1.4;
access;
symbols;
locks; strict;
comment	@# @;


1.4
date	2001.07.27.23.14.20;	author stack;	state Exp;
branches;
next	1.3;

1.3
date	2001.07.27.19.34.02;	author leonardr;	state Exp;
branches;
next	1.2;

1.2
date	2001.07.27.19.33.36;	author stack;	state Exp;
branches;
next	1.1;

1.1
date	2001.07.27.01.41.13;	author stack;	state Exp;
branches;
next	;


desc
@@


1.4
log
@Add handling of newly added methods.  Add a general result handler.  Add
fix for methods that take vectors as arguments.
@
text
@#!/usr/bin/perl -w
##
## Client for the tigris xml-rpc permissions checking service.
## 
## See usage for examples and how to use this client.  See
## http://helm.tigris.org/docs/services_xmlrpc.html for general 
## documentation on the helm xml rpc service.
##
## $Id: TestXMLRPCClient.pl,v 1.3 2001/07/27 19:34:02 leonardr Exp $
##
use strict;
use Getopt::Long;
use File::Basename;
use Frontier::Client;


## Globals
##
$::script_name = basename( $0 );

# This is list of supported actions. See usage for list of arguments each 
# method takes.
#
%::supportedActions = ( 
    "userInfoFromID" => "user.getUserInfo", 
    "userInfoFromIDs" => "user.getUserInfo", 
    "userInfoFromLoginName" => "user.getUserInfo", 
    "validLogin" => "user.isValidLogin", 
    "permissionSet" => "permission.getPermissionSet", 
    "resourcesForAction" => "permission.getResourcesForAction", 
    "usersWithAction" => "permission.getUsersWithAction" );


## Program main
##
main( );

sub main
{
    my( $action, $url, $auth, $debug, @@args ) = cmdline_args( );     

    # Make the rpc call.  Turn on 'user_objects' because
    # results can be problematic to handle if they have '@@'
    # signs, etc., in them (Perl tries to interpret as an array).
    #
    my $rpcHandle = Frontier::Client->new( 'url' => $url, 
        'debug' => $debug,
        'use_objects' => 0 );   
    my $resultRef = undef;

    # Methods that take a vector require special treatment. Pass array by 
    # reference to make the xml-rpc client pass a vector.  Otherwise passes 
    # multiple strings.
    #
    if( $action eq "permissionSet" )
    {
        my $args_length = @@args;
        die "$action takes 3 args (at least)." if( $args_length < 3 );
        $resultRef 
            = $rpcHandle->call( $::supportedActions{$action}, $auth, 
                shift @@args, shift @@args, \@@args );
    }
    elsif( $action eq "userInfoFromIDs" )
    {
        my $args_length = @@args;
        die "$action takes 1 arg (at least)." if( $args_length < 1 );
        $resultRef 
            = $rpcHandle->call( $::supportedActions{$action}, $auth, \@@args ); 
    }
    else
    {
        # Generic call.  Works for all cases but for methods that take vectors.
        #
        $resultRef 
            = $rpcHandle->call( $::supportedActions{$action}, $auth, @@args );
    }

    # Examine results returned.  Can be scalar, hash or array.  Can be arrays
    # of scalars or hashes.  Depends upon method called.  Below interrogates
    # results expanding whatever it finds.
    #
    if( defined( $resultRef ) ) { printValue( $resultRef ); }
    else { print "Undefined result.\n"; }
}

## Print out a hash. 
##
sub printHash
{
    my ( $hashRef ) = @@_;

    for my $key ( keys( %$hashRef ) )
    {
        my $value = $hashRef->{$key};
        printValue( $value );
    }
}

## Print out an array. 
##
sub printArray
{
    my ( $arrayRef ) = @@_;
    for my $value ( @@$arrayRef )
    {
        printValue( $value );
    }
}

## Print a value.  Check its type before trying.
##
sub printValue
{
    my ( $value ) = @@_;
    my $ref = ref( $value );
    if( not $ref ) { print $value, "\n"; }
    elsif( $ref eq 'ARRAY' ) { printArray( $value ); }
    elsif( $ref eq 'HASH' ) { printHash( $value ); }
    elsif( $ref =~ m|^Frontier::RPC2::.*| ) { print $value->value( ); }
    else { print "Unknown type: $ref\n"; }
}

## Process command-line arguments.  Does not return if user asked for help.
##
sub cmdline_args
{
    my $param_action = undef;
    my $param_url = undef;
    my $param_auth = undef;
    my $opt_help = undef;
    my $opt_debug = undef;

    my $result = GetOptions( "h" => \$opt_help,
                                "debug" => \$opt_debug,
                                "help" => \$opt_help,
                                "a=s" => \$param_action,
                                "action=s" => \$param_action,
                                "p=s" => \$param_auth,
                                "auth=s" => \$param_auth,
                                "u=s" => \$param_url,
                                "url=s" => \$param_url );        

    $result || die "GetOptions error.";

    usage( ) if( defined( $opt_help ) );
    usage( ) unless( defined( $param_action ) 
        and defined( $param_auth )
        and defined( $param_url ) );

    my $supported = 0;
    for my $action ( keys( %::supportedActions ) ) 
    {
       next unless( $action eq $param_action );
       $supported = 1;
    }
    print "Unsupported action: $param_action" unless $supported;

    if( $#ARGV < 0 )
    {
        print "ACTIONS require at least one argument\n";
        usage( );
    };

    return ( $param_action, $param_url, $param_auth, $opt_debug, @@ARGV );
}


## Usage
##
## Print usage for this script.
##
sub usage
{
    
    print <<"SCRIPT_USAGE";
Usage: $::script_name (-h|--help)|(--action=ACTION --url=URL --auth=AUTH ARGS)
    
Params:
 -h, --help       Prints this message
 --action=ACTION  Where ACTION is one of following: 

                    userInfoFromID
                    userInfoFromLoginName
                    validLogin
                    permissionSet
                    usersWithAction

                  The ACTION dictates ARGS to pass.  See 
                  org.tigris.helm.security.PermissionHandler
                  for methods supported by tigris permission checker.
 --url=URL        URL for the xml rpc server (And args to pass).
 --auth=AUTH      AUTH string.  Usually the db password.
 --debug          Enable debugging.
 ARGS             If ACTION=userInfoFromID, pass a UserID
                  If ACTION=userInfoFromLoginName, pass a domain and user name. 
                  If ACTION=validLogin, pass domain, userName and password. 
                  If ACTION=permissionSet, pass a UserID, a ProjectID, and a 
                  list of actions (e.g. "Project - View").  
                  if ACTION=resourcesForAction, pass domain, project name,
                  user name and an action string.
                  If ACTION=usersWithAction, pass a ProjectID and an action.

Example:
    %  ./TestXMLRPCClient.pl --action=usersWithAction --auth=euphrates \\
            --url=http://localhost:16500 5 "Project - View"

    % ./TestXMLRPCClient.pl --action=userInfoFromLoginName --auth=euphrates \\
            --url=http://localhost:16500 "marx.sp.collab.net" "root"

    % ./TestXMLRPCClient.pl --action=validLogin --auth=euphrates \\
            --url=http://localhost:16500 marx.sp.collab.net root wrong_password

    % ./TestXMLRPCClient.pl --action=resourcesForAction \\
            --url=http://localhost:16500 --auth=euphrates --debug \\
            marx.sp.collab.net www root "Project - Edit       

SCRIPT_USAGE
    
    exit( 0 );
}
@


1.3
log
@Changed package names of XML-RPC methods.
@
text
@d4 4
d9 1
a9 6
## Problem: ./TestXMLRPCClient.pl --action=usersWithAction \\
##    --auth=euphrates --url=http://localhost:16500 5 "Project - View"
## Does not work because value has a '@@' in it and perl is interpreting
## it as an array.
##
## $Id: TestXMLRPCClient.pl,v 1.2 2001/07/27 19:33:36 stack Exp $
a11 1
# use diagnostics;
d21 2
a22 1
# See the usage for list of arguments each method takes.
d26 1
d28 1
d30 1
d49 1
d51 4
a54 1
    my $resultRef = undef;
a56 4
        # This method requires special-handling.  Method takes a vector.
        # Pass array by reference to make the xml-rpc client pass a
        # vector rather than multiple strings.
        #
d58 1
a58 1
        die "permissionSet takes 3 args (at least)." if( $args_length < 3 );
d63 7
d72 1
a72 1
        # Generic call.
d78 3
a80 2
    # Examine results returned.  Can be scalar, hash or array.  Depends upon 
    # method called.
d184 1
d195 7
a201 5
                  If ACTION=userInfoFromLoginName, pass a domain and 
                  a user name. If ACTION=permissionSet, pass a UserID,
                  a ProjectID, and a list of actions 
                  (e.g. "Project - View").  If ACTION=usersWithAction, 
                  pass a ProjectID and an action.
d209 8
@


1.2
log
@Made more generic. Handles variety of result types.

CVS ----------------------------------------------------------------------
@
text
@d10 1
a10 1
## $Id: TestXMLRPCClient.pl,v 1.1 2001/07/27 01:41:13 stack Exp $
d26 2
a27 2
    "userInfoFromID" => "permission.getUserInfo", 
    "userInfoFromLoginName" => "permission.getUserInfo", 
@


1.1
log
@Perl client to exercise tigris permission checking system.

(Not yet fully tested.  Checking in what I have so far).
@
text
@d10 1
a10 1
## $Id$
d46 16
a61 4
        'use_objects' => 1 );
    my $resultRef 
        = $rpcHandle->call( $::supportedActions{$action}, $auth, @@args );
    if( defined $resultRef )
d63 4
a66 9
        for my $key ( keys( %$resultRef ) )
        {
            my $valueAsObject = $resultRef->{$key};
            if( defined $valueAsObject )
            {
                my $value = $valueAsObject->value( );
                print( "$key: $value\n" );
            }
        }
d68 43
@

