Apache-Sling
view release on metacpan or search on metacpan
lib/Apache/Sling.pm view on Meta::CPAN
# control the maximum number of forks that can be
# created when testing concurrency:
$max_allowed_forks =
( defined $max_allowed_forks ? $max_allowed_forks : 32 );
my $auth;
my $authn;
my $help;
my $log;
my $man;
my $number_forks = 1;
my $password;
my $url;
my $user;
my $verbose;
my $sling = {
MaxForks => $max_allowed_forks,
Auth => $auth,
Authn => $authn,
Help => $help,
Log => $log,
Man => $man,
Pass => $password,
Threads => $number_forks,
URL => $url,
User => $user,
Verbose => $verbose
};
bless $sling, $class;
return $sling;
}
#}}}
lib/Apache/Sling/Authn.pm view on Meta::CPAN
#}}}
#{{{sub login_user
sub login_user {
my ($authn) = @_;
$authn->{'Type'} =
( defined $authn->{'Type'} ? $authn->{'Type'} : 'basic' );
# Apply basic authentication to the user agent if url, username and
# password are supplied:
if ( defined $authn->{'BaseURL'}
&& defined $authn->{'Username'}
&& defined $authn->{'Password'} )
{
if ( $authn->{'Type'} eq 'basic' ) {
my $success = $authn->basic_login();
if ( !$success ) {
if ( $authn->{'Verbose'} >= 1 ) {
Apache::Sling::Print::print_result($authn);
}
lib/Apache/Sling/Authn.pm view on Meta::CPAN
Apache::Sling::Print::print_result($authn);
}
}
return 1;
}
#}}}
#{{{sub switch_user
sub switch_user {
my ( $authn, $new_username, $new_password, $type, $check_basic ) = @_;
if ( !defined $new_username ) {
croak 'New username to switch to not defined';
}
if ( !defined $new_password ) {
croak 'New password to use in switch not defined';
}
if ( ( $authn->{'Username'} !~ /^$new_username$/msx )
|| ( $authn->{'Password'} !~ /^$new_password$/msx ) )
{
my $old_username = $authn->{'Username'};
my $old_password = $authn->{'Password'};
my $old_type = $authn->{'Type'};
$authn->{'Username'} = $new_username;
$authn->{'Password'} = $new_password;
if ( defined $type ) {
$authn->{'Type'} = $type;
}
$check_basic = ( defined $check_basic ? $check_basic : 0 );
if ( $authn->{'Type'} eq 'basic' ) {
if ($check_basic) {
my $success = $authn->basic_login();
if ( !$success ) {
# Reset credentials:
$authn->{'Username'} = $old_username;
$authn->{'Password'} = $old_password;
$authn->{'Type'} = $old_type;
croak
"Basic Auth log in for user \"$new_username\" at URL \""
. $authn->{'BaseURL'}
. "\" was unsuccessful\n";
}
}
else {
$authn->{'Message'} = 'Fast User Switch completed!';
}
}
else {
# Reset credentials:
$authn->{'Username'} = $old_username;
$authn->{'Password'} = $old_password;
$authn->{'Type'} = $old_type;
croak "Unsupported auth type: \"$type\"\n";
}
}
else {
$authn->{'Message'} = 'User already active, no need to switch!';
}
if ( $authn->{'Verbose'} >= 1 ) {
Apache::Sling::Print::print_result($authn);
}
lib/Apache/Sling/Authz.pm view on Meta::CPAN
--(no-)addChildNodes - Grant or deny the addChildNodes privilege
--(no-)all - Grant or deny all above privileges
--(no-)modifyACL - Grant or deny the modifyACL privilege
--(no-)modifyProps - Grant or deny the modifyProperties privilege
--(no-)readACL - Grant or deny the readACL privilege
--(no-)read - Grant or deny the read privilege
--(no-)removeChilds - Grant or deny the removeChildNodes privilege
--(no-)removeNode - Grant or deny the removeNode privilege
--(no-)write - Grant or deny the write privileges:
modifyProperties,addChildNodes,removeNode,removeChildNodes
--pass or -p (password) - Password of user performing content manipulations.
--principal or -P (principal) - Principal to grant, deny, or delete privilege for.
--remote or -r (remoteNode) - specify remote node under JCR root to act on.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform content manipulations as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
--view or -V - view access control list for node.
Options may be merged together. -- stops processing of options.
Space is not required between options and their arguments.
For full details run: perl $0 --man
lib/Apache/Sling/Content.pm view on Meta::CPAN
--add or -a - Add content.
--auth (type) - Specify auth type. If ommitted, default is used.
--copy or -c - Copy content.
--delete or -d - Delete content.
--filename or -n (filename) - Specify file name to use for content upload.
--help or -? - view the script synopsis and options.
--local or -l (localPath) - Local path to content to upload.
--log or -L (log) - Log script output to specified log file.
--man or -M - view the full script documentation.
--move or -m - Move content.
--pass or -p (password) - Password of user performing content manipulations.
--property or -P (property) - Specify property to set on node.
--remote or -r (remoteNode) - specify remote destination under JCR root to act on.
--remote-source or -S (remoteSrc) - specify remote source node under JCR root to act on.
--replace or -R - when copying or moving, overwrite remote destination if it exists.
--threads or -t (threads) - Used with -A, defines number of parallel
processes to have running through file.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform content manipulations as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
--view or -V (actOnGroup) - view details for specified group in json format.
lib/Apache/Sling/Group.pm view on Meta::CPAN
The following options are accepted:
--additions or -A (file) - file containing list of groups to be added.
--add or -a (actOnGroup) - add specified group.
--auth (type) - Specify auth type. If ommitted, default is used.
--delete or -d (actOnGroup) - delete specified group.
--exists or -e (actOnGroup) - check whether specified group exists.
--help or -? - view the script synopsis and options.
--log or -L (log) - Log script output to specified log file.
--man or -M - view the full script documentation.
--pass or -p (password) - Password of user performing actions.
--property or -P (property=value) - Specify property to set on group.
--threads or -t (threads) - Used with -A, defines number of parallel
processes to have running through file.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform any actions as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
--view or -V (actOnGroup) - view details for specified group in json format.
Options may be merged together. -- stops processing of options.
Space is not required between options and their arguments.
lib/Apache/Sling/GroupMember.pm view on Meta::CPAN
--additions or -A (file) - file containing list of members to be added to groups.
--add or -a (member) - add specified member.
--auth (type) - Specify auth type. If ommitted, default is used.
--delete or -d (member) - delete specified group member.
--exists or -e (member) - check whether specified member exists in group.
--group or -g (actOnGroup) - group to perform membership actions on.
--help or -? - view the script synopsis and options.
--log or -L (log) - Log script output to specified log file.
--man or -M - view the full script documentation.
--pass or -p (password) - Password of user performing actions.
--threads or -t (threads) - Used with -A, defines number of parallel
processes to have running through file.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform any actions as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
--view or -V - view members of specified group.
Options may be merged together. -- stops processing of options.
Space is not required between options and their arguments.
For full details run: perl $0 --man
lib/Apache/Sling/JsonQueryServlet.pm view on Meta::CPAN
print <<"EOF";
Usage: perl $0 [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
The following options are accepted:
--all_nodes or -a - Return a JSON representation of all nodes in the system.
--auth (type) - Specify auth type. If ommitted, default is used.
--help or -? - view the script synopsis and options.
--log or -L (log) - Log script output to specified log file.
--man or -M - view the full script documentation.
--pass or -p (password) - Password of user performing json queries.
--threads or -t (threads) - Used with -A, defines number of parallel
processes to have running through file.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform queries as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
Options may be merged together. -- stops processing of options.
Space is not required between options and their arguments.
For full details run: perl $0 --man
EOF
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
#{{{sub ldap_connect
sub ldap_connect {
my ($class) = @_;
$class->{'LDAP'} = Net::LDAP->new( $class->{'LDAPHost'} )
or croak 'Problem opening a connection to the LDAP server!';
if ( defined $class->{'LDAPDN'} && defined $class->{'LDAPPASS'} ) {
my $mesg = $class->{'LDAP'}->bind(
$class->{'LDAPDN'},
password => $class->{'LDAPPASS'},
version => '3'
) or croak 'Problem with authenticated bind to LDAP server!';
}
else {
my $mesg = $class->{'LDAP'}->bind( version => '3' )
or croak 'Problem with anonymous bind to LDAP server!';
}
return 1;
}
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
print "No user modifications, skipping: $user_id\n"
or croak q{Problem printing!};
}
}
}
else {
# We have never seen this user before:
print "Creating new user: $user_id\n" or croak q{Problem printing!};
${ $class->{'User'} }
->add( $user_id, 'password', \@properties_array )
or croak q(Problem adding new user to sling instance!);
$properties_hash{ $class->{'Disabled'} } = '0';
$synch_cache->{$user_id} = \%properties_hash;
}
}
return 0;
}
#}}}
lib/Apache/Sling/LDAPSynch.pm view on Meta::CPAN
--flag-disabled or -f - property to denote user should be disabled.
--help or -? - View the script synopsis and options.
--ldap-attributes or -A (attribs) - Specify ldap attributes to be updated.
--ldap-base or -B (ldapBase) - Specify ldap base to synchronize users from.
--ldap-dn or -D (ldapDN) - Specify ldap DN for authentication.
--ldap-filter or -F (filter) - Specify ldap attribute to search for users with.
--ldap-host or -H (host) - Specify ldap host to synchronize from.
--ldap-pass or -P (pass) - Specify ldap pass for authentication.
--log or -L (log) - Log script output to specified log file.
--man or -M - View the full script documentation.
--pass or -p (password) - Password of user performing actions.
--synch-full or -s - Perform a full synchronization from ldap to sling.
--synch-full-since or -S (since) - Perform a full synchronization from ldap to sling using changes since specified time.
--synch-listed or -l - Perform a sychronization of listed users from ldap to sling.
--synch-listed-since (since) - Perform a sychronization of listed users from ldap to sling using changes since specified time.
--upload-user-list (userList) - Upload user list specified by file userList.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform any actions as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
Options may be merged together. -- stops processing of options.
lib/Apache/Sling/Request.pm view on Meta::CPAN
if ( defined $target ) {
$request = GET "$target";
}
else {
croak 'Error generating request for blank target!';
}
}
if ( defined ${$authn}->{'Type'} ) {
if ( ${$authn}->{'Type'} eq 'basic' ) {
my $username = ${$authn}->{'Username'};
my $password = ${$authn}->{'Password'};
if ( defined $username && defined $password ) {
# Always add an Authorization header to deal with application not
# properly requesting authentication to be sent:
my $encoded = 'Basic ' . encode_base64("$username:$password");
$request->header( 'Authorization' => $encoded );
}
}
}
if ( defined $verbose && $verbose >= 2 ) {
Apache::Sling::Print::print_with_lock(
"**** String representation of compiled request:\n"
. $request->as_string,
$log
);
lib/Apache/Sling/User.pm view on Meta::CPAN
# First field must be site:
if ( $column_headings[0] !~ /^[Uu][Ss][Ee][Rr]$/msx ) {
croak
'First CSV column must be the user ID, column heading must be "user". Found: "'
. $column_headings[0] . "\".\n";
}
if ( $column_headings[1] !~
/^[Pp][Aa][Ss][Ss][Ww][Oo][Rr][Dd]$/msx )
{
croak
'Second CSV column must be the user password, column heading must be "password". Found: "'
. $column_headings[1] . "\".\n";
}
$number_of_columns = @column_headings;
}
else {
croak 'CSV broken, failed to parse line: '
. $csv->error_input;
}
}
elsif ( $fork_id == ( $count++ % $number_of_forks ) ) {
lib/Apache/Sling/User.pm view on Meta::CPAN
if ( $csv->parse($_) ) {
my @columns = $csv->fields();
my $columns_size = @columns;
# Check row has same number of columns as there were column headings:
if ( $columns_size != $number_of_columns ) {
croak
"Found \"$columns_size\" columns. There should have been \"$number_of_columns\".\nRow contents was: $_";
}
my $id = $columns[0];
my $password = $columns[1];
for ( my $i = 2 ; $i < $number_of_columns ; $i++ ) {
my $heading = $column_headings[$i];
my $data = $columns[$i];
my $value = "$heading=$data";
push @properties, $value;
}
$user->add( $id, $password, \@properties );
Apache::Sling::Print::print_result($user);
}
else {
croak q{CSV broken, failed to parse line: }
. $csv->error_input;
}
}
}
close $input or croak q{Problem closing input};
}
else {
croak "Problem opening file: '$file'";
}
return 1;
}
#}}}
#{{{sub change_password
sub change_password {
my ( $user, $act_on_user, $act_on_pass, $new_pass, $new_pass_confirm ) = @_;
my $res = Apache::Sling::Request::request(
\$user,
Apache::Sling::UserUtil::change_password_setup(
$user->{'BaseURL'}, $act_on_user, $act_on_pass,
$new_pass, $new_pass_confirm
)
);
my $success = Apache::Sling::UserUtil::change_password_eval($res);
my $message = "User: \"$act_on_user\" ";
$message .= ( $success ? 'password changed!' : 'password not changed!' );
$user->set_results( "$message", $res );
return $success;
}
#}}}
#{{{sub check_exists
sub check_exists {
my ( $user, $act_on_user ) = @_;
my $res = Apache::Sling::Request::request(
lib/Apache/Sling/User.pm view on Meta::CPAN
my $user_config = $user->config_hash( $sling, @ARGV );
GetOptions(
$user_config, 'auth=s',
'help|?', 'log|L=s',
'man|M', 'pass|p=s',
'threads|t=s', 'url|U=s',
'user|u=s', 'verbose|v+',
'add|a=s', 'additions|A=s',
'change-password|c=s', 'delete|d=s',
'email|E=s', 'first-name|f=s',
'exists|e=s', 'last-name|l=s',
'new-password|n=s', 'password|w=s',
'property|P=s', 'update=s',
'view|V=s'
) or $user->help();
return $user_config;
}
#}}}
#{{{sub config_hash
sub config_hash {
my ( $user, $sling, @ARGV ) = @_;
my $password;
my $additions;
my $add;
my $change_password;
my $delete;
my $email;
my $exists;
my $first_name;
my $last_name;
my $new_password;
my @property;
my $update;
my $view;
my %user_config = (
'auth' => \$sling->{'Auth'},
'help' => \$sling->{'Help'},
'log' => \$sling->{'Log'},
'man' => \$sling->{'Man'},
'pass' => \$sling->{'Pass'},
'threads' => \$sling->{'Threads'},
'url' => \$sling->{'URL'},
'user' => \$sling->{'User'},
'verbose' => \$sling->{'Verbose'},
'add' => \$add,
'additions' => \$additions,
'change-password' => \$change_password,
'delete' => \$delete,
'email' => \$email,
'exists' => \$exists,
'first-name' => \$first_name,
'last-name' => \$last_name,
'new-password' => \$new_password,
'password' => \$password,
'property' => \@property,
'update' => \$update,
'view' => \$view
);
return \%user_config;
}
#}}}
lib/Apache/Sling/User.pm view on Meta::CPAN
#{{{ sub help
sub help {
print <<"EOF";
Usage: perl $0 [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
The following options are accepted:
--add or -a (actOnUser) - add specified user name.
--additions or -A (file) - file containing list of users to be added.
--auth (type) - Specify auth type. If ommitted, default is used.
--change-password or -c (actOnUser) - change password of specified user name.
--delete or -d (actOnUser) - delete specified user name.
--email or -E (email) - specify email address property for user.
--exists or -e (actOnUser) - check whether specified user exists.
--first-name or -f (firstName) - specify first name property for user.
--help or -? - view the script synopsis and options.
--last-name or -l (lastName) - specify last name property for user.
--log or -L (log) - Log script output to specified log file.
--man or -M - view the full script documentation.
--me or -m - me returns json representing authenticated user.
--new-password or -n (newPassword) - Used with -c, new password to set.
--password or -w (actOnPass) - Password of user being actioned.
--pass or -p (password) - Password of user performing actions.
--property or -P (property=value) - Specify property to set on user.
--threads or -t (threads) - Used with -A, defines number of parallel
processes to have running through file.
--update (actOnUser) - update specified user name, used with -P.
--url or -U (URL) - URL for system being tested against.
--user or -u (username) - Name of user to perform any actions as.
--verbose or -v or -vv or -vvv - Increase verbosity of output.
--view or -V (actOnUser) - view details for specified user in json format.
Options may be merged together. -- stops processing of options.
lib/Apache/Sling/User.pm view on Meta::CPAN
line. The script also acts as a reference implementation for the User perl
library.
EOF
$user->help();
print <<"EOF";
Example Usage
* Add user "testuser" with password "test"
perl $0 -U http://localhost:8080 -a testuser -w test
* View information about authenticated user "testuser"
perl $0 -U http://localhost:8080 --me -u testuser -p test
* Authenticate as admin and check whether user "testuser" exists
perl $0 -U http://localhost:8080 -e testuser -u admin -p admin
lib/Apache/Sling/User.pm view on Meta::CPAN
new Apache::Sling::User( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $user->check_exists( ${ $config->{'exists'} } );
}
elsif ( defined ${ $config->{'add'} } ) {
$user =
new Apache::Sling::User( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $user->add(
${ $config->{'add'} },
${ $config->{'password'} },
$config->{'property'}
);
}
elsif ( defined ${ $config->{'update'} } ) {
$user =
new Apache::Sling::User( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success =
$user->update( ${ $config->{'update'} }, $config->{'property'} );
}
elsif ( defined ${ $config->{'change-password'} } ) {
$user =
new Apache::Sling::User( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $user->change_password(
${ $config->{'change-password'} },
${ $config->{'password'} },
${ $config->{'new-password'} },
${ $config->{'new-password'} }
);
}
elsif ( defined ${ $config->{'delete'} } ) {
$user =
new Apache::Sling::User( \$authn, $sling->{'Verbose'},
$sling->{'Log'} );
$success = $user->del( ${ $config->{'delete'} } );
}
elsif ( defined ${ $config->{'view'} } ) {
$user =
lib/Apache/Sling/User.pm view on Meta::CPAN
Set a suitable message and response for the user object.
=head2 add
Add a new user to the system.
=head2 add_from_file
Add new users to the system based on definitions in a file.
=head2 change_password
Change the password for a user.
=head2 check_exists
Check whether a user exists.
=head2 config
Fetch hash of user configuration.
=head2 del
lib/Apache/Sling/UserUtil.pm view on Meta::CPAN
our $VERSION = '0.27';
#{{{sub add_setup
sub add_setup {
my ( $base_url, $act_on_user, $act_on_pass, $properties ) = @_;
if ( !defined $base_url ) { croak 'No base url defined to add against!'; }
if ( !defined $act_on_user ) { croak 'No user name defined to add!'; }
if ( !defined $act_on_pass ) {
croak "No user password defined to add for user $act_on_user!";
}
my $property_post_vars =
Apache::Sling::URL::properties_array_to_string($properties);
my $post_variables =
"\$post_variables = [':name','$act_on_user','pwd','$act_on_pass','pwdConfirm','$act_on_pass'";
if ( $property_post_vars ne q{} ) {
$post_variables .= ",$property_post_vars";
}
$post_variables .= ']';
return "post $base_url/system/userManager/user.create.html $post_variables";
lib/Apache/Sling/UserUtil.pm view on Meta::CPAN
# to support Sakai Nakamura using the more correct
# 201 "Created" return code:
sub add_eval {
my ($res) = @_;
return ( ${$res}->code =~ /^20(0|1)$/x );
}
#}}}
#{{{sub change_password_setup
sub change_password_setup {
my ( $base_url, $act_on_user, $act_on_pass, $new_pass, $new_pass_confirm ) =
@_;
if ( !defined $base_url ) { croak 'No base url defined!'; }
if ( !defined $act_on_user ) {
croak 'No user name defined to change password for!';
}
if ( !defined $act_on_pass ) {
croak "No current password defined for $act_on_user!";
}
if ( !defined $new_pass ) {
croak "No new password defined for $act_on_user!";
}
if ( !defined $new_pass_confirm ) {
croak "No confirmation of new password defined for $act_on_user!";
}
my $post_variables =
"\$post_variables = ['oldPwd','$act_on_pass','newPwd','$new_pass','newPwdConfirm','$new_pass_confirm']";
return
"post $base_url/system/userManager/user/$act_on_user.changePassword.html $post_variables";
}
#}}}
#{{{sub change_password_eval
sub change_password_eval {
my ($res) = @_;
return ( ${$res}->code eq '200' );
}
#}}}
#{{{sub delete_setup
sub delete_setup {
my ( $base_url, $act_on_user ) = @_;
lib/Apache/Sling/UserUtil.pm view on Meta::CPAN
=head2 add_setup
Returns a textual representation of the request needed to add the user to the
system.
=head2 add_eval
Check result of adding user to the system.
=head2 change_password_setup
Returns a textual representation of the request needed to change the password
of the user in the system.
=head2 change_password_eval
Verify whether the change password attempt for the user in the system was successful.
=head2 delete_setup
Returns a textual representation of the request needed to delete the user from
the system.
=head2 delete_eval
Check result of deleting user from the system.
t/External/Apache-Sling-Authn.t view on Meta::CPAN
# test properties:
my @test_properties;
# sling object:
my $sling = Apache::Sling->new();
isa_ok $sling, 'Apache::Sling', 'sling';
$sling->{'URL'} = $sling_host;
$sling->{'User'} = $super_user;
$sling->{'Log'} = $log;
# Check creating authn object fails with bad password:
$sling->{'Pass'} = 'badpasswordwillnotwork';
# Check creation with verbosity turned up:
$sling->{'Verbose'} = 3;
my $authn = Apache::Sling::Authn->new( \$sling );
isa_ok $authn, 'Apache::Sling::Authn', 'authentication';
throws_ok{ $authn->login_user() } qr%Basic Auth log in for user "$super_user" at URL "$sling_host" was unsuccessful%, 'Check authn object creation croaks with bad password and high verbosity';
# reset verbosity level:
$sling->{'Verbose'} = $verbose;
$authn = Apache::Sling::Authn->new( \$sling );
isa_ok $authn, 'Apache::Sling::Authn', 'authentication';
throws_ok{ $authn->login_user() } qr%Basic Auth log in for user "$super_user" at URL "$sling_host" was unsuccessful%, 'Check authn object creation croaks with bad password and default verbosity';
# Set the password to something that should work!
$sling->{'Pass'} = $super_pass;
# Check creating authn object fails with unsupported auth type:
$sling->{'Auth'} = 'badauthtypewillnotwork';
$authn = Apache::Sling::Authn->new( \$sling );
isa_ok $authn, 'Apache::Sling::Authn', 'authentication';
throws_ok{ $authn->login_user() } qr/Unsupported auth type: "badauthtypewillnotwork"/, 'Check authn object creation croaks with unsupported auth type';
# Set the auth type to something that should work!
$sling->{'Auth'} = undef;
t/External/Apache-Sling-Authn.t view on Meta::CPAN
ok( $user->add( $test_user1, $test_pass, \@test_properties ),
"Authn Test: User \"$test_user1\" added successfully." );
ok( $user->check_exists( $test_user1 ),
"Authn Test: User \"$test_user1\" exists." );
ok( $user->add( $test_user2, $test_pass, \@test_properties ),
"Authn Test: User \"$test_user2\" added successfully." );
ok( $user->check_exists( $test_user2 ),
"Authn Test: User \"$test_user2\" exists." );
throws_ok{ $authn->switch_user( $test_user1, $test_pass, "badauthtypewillnotwork", 1 ) } qr/Unsupported auth type: "badauthtypewillnotwork"/, 'Check switch_user croaks with unsupported auth type';
throws_ok{ $authn->switch_user( "baduser", "badpassword", "basic", 1 ) } qr/Basic Auth log in for user "baduser" at URL "$sling_host" was unsuccessful/, 'Check switch_user croaks with bad credentials';
throws_ok{ $authn->switch_user( $super_user, "badpassword", "basic", 1 ) } qr/Basic Auth log in for user "$super_user" at URL "$sling_host" was unsuccessful/, 'Check switch_user croaks with bad password';
ok( $authn->switch_user( $test_user1, $test_pass, "basic", 1 ),
"Authn Test: Successfully switched to user: \"$test_user1\" with basic auth" );
ok( $authn->switch_user( $test_user1, $test_pass, "basic", 1 ),
"Authn Test: Successfully stayed as user: \"$test_user1\"" );
ok( $authn->switch_user( $test_user2, $test_pass, "basic", 1 ),
"Authn Test: Successfully switched to user: \"$test_user2\" with basic auth" );
$authn->{'Verbose'} = 3;
ok( $authn->switch_user( $super_user, $super_pass, "basic", 1 ),
"Authn Test: Successfully switched back to user: \"$super_user\" with basic auth" );
$authn->{'Verbose'} = $verbose;
t/External/Apache-Sling-User.t view on Meta::CPAN
# Check can update properties:
@test_properties = ( "user_test_editor=$test_user" );
ok( $user->update( $test_user, \@test_properties ),
"User Test: User \"$test_user\" updated successfully." );
# switch back to admin user:
ok( $authn->switch_user( $super_user, $super_pass ),
"User Test: Successfully switched to user: \"$super_user\" with basic auth" );
# Change user's password:
ok( $user->change_password( $test_user, $test_pass, $test_pass_new, $test_pass_new ),
"User Test: Successfully changed password from \"$test_pass\" to \"$test_pass_new\" for user: \"$test_user\"");
ok( ! $user->change_password( "non-existent-$test_user", $test_pass, $test_pass_new, $test_pass_new ),
"User Test: non-existent user password change not successful");
# Switch to test_user with new pass:
ok( $authn->switch_user( $test_user, $test_pass_new ),
"User Test: Successfully switched to user: \"$test_user\" with basic auth and new pass" );
# switch back to admin user:
ok( $authn->switch_user( $super_user, $super_pass ),
"User Test: Successfully switched to user: \"$super_user\" with basic auth" );
# Testing view for user:
t/External/Apache-Sling-User.t view on Meta::CPAN
ok( ! $user->view( "non-existent-$test_user" ),
"User Test: non-existent user not viewed successfully." );
# Testing user addition from file
# test user name:
my $test_upload_user1 = "user_test_upload_user_1_$$";
my $test_upload_user2 = "user_test_upload_user_2_$$";
my $test_upload_user3 = "user_test_upload_user_3_$$";
my $test_upload_user4 = "user_test_upload_user_4_$$";
my $upload = "user,password\n$test_upload_user1,$test_pass";
ok( $user->add_from_file(\$upload,0,1), 'Check add_from_file function' );
$upload = "user,password\n$test_upload_user2,$test_pass\n$test_upload_user3,$test_pass\n$test_upload_user4,$test_pass";
ok( $user->add_from_file(\$upload,0,3), 'Check add_from_file function with three forks' );
$upload = "user,bad_heading\n$test_upload_user1,$test_pass";
throws_ok{ $user->add_from_file(\$upload,0,1); } qr%Second CSV column must be the user password, column heading must be "password". Found: "bad_heading".%, 'Check add_from_file function with bad second heading';
$upload = "user,password\n$test_upload_user1,$test_pass,bad_extra_column";
throws_ok{ $user->add_from_file(\$upload,0,1); } qr%Found "3" columns. There should have been "2".%, 'Check add_from_file function with heading / data count mismatch';
$upload = "user,password,property\n$test_upload_user2,$test_pass,test";
ok( $user->add_from_file(\$upload,0,1), 'Check add_from_file function with extra property specified' );
# Check user deletion:
ok( ! $user->del( "non-existent-$test_user" ),
"User Test: non-existent user not deleted successfully." );
ok( $user->del( $test_user ),
"User Test: User \"$test_user\" deleted successfully." );
ok( $user->del( $test_upload_user1 ),
"User Test: User \"$test_upload_user1\" deleted successfully." );
ok( $user->del( $test_upload_user2 ),
t/External/Apache-Sling-User.t view on Meta::CPAN
$user = Apache::Sling::User->new( \$authn, $verbose, $log );
isa_ok $user, 'Apache::Sling::User', 'user';
# add user:
ok( my $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'add'} = \$test_user;
$user_config->{'email'} = \"test\@example.com";
$user_config->{'first-name'} = \"test";
$user_config->{'last-name'} = \"test";
$user_config->{'password'} = \$test_pass1;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function adding user $test_user} );
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'exists'} = \$test_user;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function check exists user $test_user} );
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'view'} = \$test_user;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function view user $test_user} );
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'update'} = \$test_user;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function update user $test_user} );
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'change-password'} = \$test_user;
$user_config->{'password'} = \$test_pass1;
$user_config->{'new-password'} = \$test_pass2;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function update user $test_user} );
my ( $tmp_user_additions_handle, $tmp_user_additions_name ) = File::Temp::tempfile();
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
$user_config->{'additions'} = \$tmp_user_additions_name;
ok( Apache::Sling::User->run($sling,$user_config), q{check user_run function additions} );
unlink( $tmp_user_additions_name );
# Cleanup user:
ok( $user_config = Apache::Sling::User->config($sling), 'check user_config function' );
t/Local/Apache-Sling-Authn.t view on Meta::CPAN
$sling->{'Log'} = 'log.txt';
my $authn = new Apache::Sling::Authn(\$sling);
isa_ok $authn, 'Apache::Sling::Authn', 'authn';
ok( $authn->{ 'BaseURL' } eq 'http://localhost:8080', 'Check BaseURL set' );
ok( ! defined $authn->{ 'Type' }, 'Check Auth type not defined' );
ok( $authn->{ 'Log' } eq 'log.txt', 'Check Log set' );
ok( $authn->{ 'Message' } eq '', 'Check Message set' );
ok( $authn->{ 'Verbose' } == 1, 'Check Verbosity set' );
ok( ! defined $authn->{ 'Username' }, 'Check user name not defined' );
ok( ! defined $authn->{ 'Password' }, 'Check password not defined' );
ok( defined $authn->{ 'Response' }, 'Check response defined' );
$authn->set_results( 'Test Message', undef );
ok( $authn->{ 'Message' } eq 'Test Message', 'Message now set' );
ok( ! defined $authn->{ 'Response' }, 'Check response no longer defined' );
$sling->{'User'} = 'testuser';
$sling->{'Auth'} = 'advanced';
$sling->{'Referer'} = '/test/referer';
$authn = new Apache::Sling::Authn(\$sling);
isa_ok $authn, 'Apache::Sling::Authn', 'authn';
ok( $authn->{ 'Type' } eq 'advanced', 'Check Auth type set' );
ok( $authn->{ 'Username' } eq 'testuser', 'Check Auth user set' );
$authn->{'BaseURL'} = undef;
ok( ! defined $authn->{ 'BaseURL' }, 'Check base URL not defined' );
ok( $authn->login_user, 'Check login user returns fine with no base URL set');
throws_ok { $authn->switch_user } qr/New username to switch to not defined/, 'Check switch_user function croaks without new username';
throws_ok { $authn->switch_user('new_username') } qr/New password to use in switch not defined/, 'Check switch_user function croaks without new password';
t/Local/Apache-Sling-User.t view on Meta::CPAN
ok( $user->{ 'Message' } eq '', 'Check Message set' );
ok( $user->{ 'Verbose' } == 1, 'Check Verbosity set' );
ok( defined $user->{ 'Authn' }, 'Check authn defined' );
ok( defined $user->{ 'Response' }, 'Check response defined' );
$user->set_results( 'Test Message', undef );
ok( $user->{ 'Message' } eq 'Test Message', 'Message now set' );
ok( ! defined $user->{ 'Response' }, 'Check response no longer defined' );
throws_ok { $user->add() } qr/No user name defined to add!/, 'Check add function croaks without user specified';
throws_ok { $user->change_password() } qr/No user name defined to change password for!/, 'Check check_exists function croaks without user specified';
throws_ok { $user->check_exists() } qr/No user to check existence of defined!/, 'Check check_exists function croaks without user specified';
throws_ok { $user->del() } qr/No user name defined to delete!/, 'Check del function croaks without user specified';
throws_ok { $user->update() } qr/No user name defined to update!/, 'Check update function croaks without user specified';
throws_ok { $user->view() } qr/No user to check existence of defined!/, 'Check view function croaks without user specified';
my $file = "\n";
throws_ok { $user->add_from_file() } qr/File to upload from not defined/, 'Check add_from_file function croaks without file specified';
throws_ok { $user->add_from_file(\$file) } qr/First CSV column must be the user ID, column heading must be "user". Found: ""./, 'Check add_from_file function croaks with blank file';
throws_ok { $user->add_from_file('/tmp/__non__--__tnetsixe__') } qr{Problem opening file: '/tmp/__non__--__tnetsixe__'}, 'Check add_from_file function croaks with non-existent file specified';
ok( my $user_config = Apache::Sling::User->config($sling), 'check config function' );
t/Local/Apache-Sling-UserUtil.t view on Meta::CPAN
my $res = HTTP::Response->new( '200' );
my @properties = '';
ok( Apache::Sling::UserUtil::add_setup( 'http://localhost:8080', 'user', 'pass', \@properties) eq
"post http://localhost:8080/system/userManager/user.create.html \$post_variables = [':name','user','pwd','pass','pwdConfirm','pass']", 'Check add_setup function' );
ok( Apache::Sling::UserUtil::update_setup('http://localhost:8080','user',\@properties ) eq "post http://localhost:8080/system/userManager/user/user.update.html \$post_variables = []", 'Check update_setup function without any properties' );
push @properties, 'a=b';
ok( Apache::Sling::UserUtil::add_setup( 'http://localhost:8080', 'user', 'pass', \@properties) eq
"post http://localhost:8080/system/userManager/user.create.html \$post_variables = [':name','user','pwd','pass','pwdConfirm','pass','a','b']", 'Check add_setup function with properties' );
throws_ok { Apache::Sling::UserUtil::add_setup() } qr/No base url defined to add against!/, 'Check add_setup function croaks without base url';
throws_ok { Apache::Sling::UserUtil::add_setup('http://localhost:8080') } qr/No user name defined to add!/, 'Check add_setup function croaks without act_on_user';
throws_ok { Apache::Sling::UserUtil::add_setup('http://localhost:8080','testuser') } qr/No user password defined to add for user testuser!/, 'Check add_setup function croaks without act_on_pass';
ok( Apache::Sling::UserUtil::add_eval( \$res ), 'Check add_eval function' );
ok( Apache::Sling::UserUtil::change_password_setup( 'http://localhost:8080', 'user', 'pass1', 'pass2', 'pass2' ) eq
"post http://localhost:8080/system/userManager/user/user.changePassword.html \$post_variables = ['oldPwd','pass1','newPwd','pass2','newPwdConfirm','pass2']", 'Check change_password_setup function' );
throws_ok { Apache::Sling::UserUtil::change_password_setup() } qr/No base url defined!/, 'Check change_password_setup function croaks without base url';
throws_ok { Apache::Sling::UserUtil::change_password_setup('http://localhost:8080') } qr/No user name defined to change password for!/, 'Check change_password_setup function croaks without act_on_user';
throws_ok { Apache::Sling::UserUtil::change_password_setup('http://localhost:8080','user') } qr/No current password defined for user!/, 'Check change_password_setup function croaks without act_on_pass';
throws_ok { Apache::Sling::UserUtil::change_password_setup('http://localhost:8080','user','pass') } qr/No new password defined for user!/, 'Check change_password_setup function croaks without new_pass';
throws_ok { Apache::Sling::UserUtil::change_password_setup('http://localhost:8080','user','pass1','pass2') } qr/No confirmation of new password defined for user!/, 'Check change_password_setup function croaks without new_pass_confirm';
ok( Apache::Sling::UserUtil::change_password_eval( \$res ), 'Check change_password_eval function' );
ok( Apache::Sling::UserUtil::delete_setup( 'http://localhost:8080', 'user' ) eq
"post http://localhost:8080/system/userManager/user/user.delete.html \$post_variables = []", 'Check delete_setup function' );
throws_ok { Apache::Sling::UserUtil::delete_setup('http://localhost:8080') } qr/No user name defined to delete!/, 'Check delete_setup function croaks without user to delete specified';
throws_ok { Apache::Sling::UserUtil::delete_setup() } qr/No base url defined to delete against!/, 'Check delete_setup function croaks without base URL specified';
ok( Apache::Sling::UserUtil::delete_eval( \$res ), 'Check delete_eval function' );
ok( Apache::Sling::UserUtil::exists_setup( 'http://localhost:8080', 'user' ) eq
"get http://localhost:8080/system/userManager/user/user.tidy.json", 'Check exists_setup function' );
throws_ok { Apache::Sling::UserUtil::exists_setup() } qr/No base url to check existence against!/, 'Check exists_setup function croaks without base URL specified';
ok( Apache::Sling::UserUtil::exists_eval( \$res ), 'Check exists_eval function' );
ok( Apache::Sling::UserUtil::update_setup( 'http://localhost:8080','user',\@properties ) eq "post http://localhost:8080/system/userManager/user/user.update.html \$post_variables = ['a','b']", 'Check update_setup function' );
( run in 0.655 second using v1.01-cache-2.11-cpan-49f99fa48dc )