using Net::LDAPs with Net::LDAP::Control::Paged - perl

I'm trying to use Net::LDAPs with Net::LDAP::CONTROL::PAGED to return many records via a privlidged bind, but so far I have failed, miserably. I've used this Net::LDAPs extensively in the past, but I've never been able to find any documentation suggesting that it is compatible with Net::LDAP:Control::Paged. Everything I find is related to Net::LDAP.
The error message I get is: Undefined subroutine &main::process_entry called at /usr/local/share/perl/5.20.2/Net/LDAP/Search.pm line 55, line 755
Here is my code:
sub Ldap636{
my ($filter) = $_[0];
my $USERNAME = 'username';
my $PASSWORD = 'password';
my $LDAP_SERVER = 'directory.domain.edu';
my $LDAP_SSL_PORT = '636';
my $LDAP_BASE = 'ou=people,dc=domain,dc=edu';
my $userDN = "uid=$USERNAME,ou=identities,ou=special,dc=domain,dc=edu";
my $ldap = Net::LDAPS->new($LDAP_SERVER, port => $LDAP_SSL_PORT) or die "Could not create LDAP object because:\n$!";
my $ldapMsg = $ldap->bind($userDN, password => $PASSWORD);
die $ldapMsg->error if $ldapMsg->is_error;
my $page = Net::LDAP::Control::Paged->new( size => 100 );
#args = (base => "$LDAP_BASE",
callback => \&process_entry,
filter => $filter,
control => [ $page ],
);
my $cookie;
while (1) {
my $result = $ldap->search(#args);
"LDAP error: server says ",$result->error,"\n" if $result->code;
foreach my $entry ($result->entries ) {
my $cn = $entry->get_value('cn');
my $desc = $entry->get_value('description');
print "$cn - $desc\n";
}
# Get cookie from paged control
my($resp) = $result->control( LDAP_CONTROL_PAGED ) or last;
$cookie = $resp->cookie or last;
$page->cookie($cookie);
}
$ldap->unbind;
}

The error message I get is: Undefined subroutine &main::process_entry
called at /usr/local/share/perl/5.20.2/Net/LDAP/Search.pm line 55,
line 755
You have written process_entry as a callback but you didn't write that subroutine. That's why you are getting the above error.

Related

perl LDAP entry not recognised

We are writing a Perl code (to be run from Unix) which will reset the password of a Windows AD User. (We are not using powershell as we have been asked not to use Windows scripts).
With the following Perl code, we are able to connect to the AD User directory and query the correct user.
#!/usr/bin/perl -w
#########################
#This script resets the password in active user directory
#########################
use strict;
use warnings;
use DBI;
use Net::LDAP;
use Net::LDAPS;
use Authen::SASL qw(Perl);
use Net::LDAP::Control::Paged;
use Time::Local;
my $CERTDIR = "<cert path>";
my $AD_PASS = "$CERTDIR/.VDIAD_pass";
my $sAN = "vahmed";
### Generate Random Password ###
my $randompass = askPasswd();
my $uninewpass;
my $mail;
my $fullname;
my $name;
my $distName;
my $finalresult;
my #AD_passwords = get_domain_pass();
my $result = reset_AD_Password();
#Reset AD user password
sub reset_AD_Password {
my $ad = Net::LDAP->new($AD_passwords[0]);
my $msg = $ad->bind(dn => "cn=$AD_passwords[2],$AD_passwords[1]",
password => $AD_passwords[3],
version => 3);
if ($msg->code)
{
print "Error :" . $msg->error() . "\n";
exit 2;
}
my $acc_name = 'sAMAccountName';
my $acc_fullname = 'displayName';
my $acc_base = 'manager';
my $acc_distName = 'distinguishedName';
my $acc_mail = 'mail';
my $act = $ad->search(
base => "$AD_passwords[1]",
filter => "(&(objectCategory=person)(sAMAccountName=$sAN))",
attrs => [$acc_name, $acc_fullname, $acc_distName, $acc_mail]);
die 1 if ($act->count() !=1 );
my $samdn = $act->entry(0)->dn;
$fullname = $samdn->get_value($acc_fullname);
$mail = $samdn->get_value($acc_mail);
}
}
However we get an error on the line:
$fullname = $samdn->get_value($acc_fullname);
$mail = $samdn->get_value($acc_mail);
The error states "Can't locate object method "get_value" via package (distinguished Name) (perhaps you forgot to load (distinguished Name))"
However the code works correctly when we replace $samdn with the following code:
foreach my $entry ($act->entries){
$name = $entry->get_value($acc_name);
$fullname = $entry->get_value($acc_fullname);
$distName = $entry->get_value($acc_distName);
$mail = $entry->get_value($acc_mail);
}
It would appear that the code is unable to identify $samdn as a Net::LDAP::Entry record.
We have tried typecasting $samdn but got the same error.
Could someone help in resolving this issue as we would not prefer to use the for loop just in case more that one record is returned by the search? Thanks in advance.
You are not assigning a Net::LDAP::Entry to $samdn. You are assigning the dn of the first entry.
# VVVV
my $samdn = $act->entry(0)->dn;
Get rid of that ->dn and it should work, if $act->entry(0) returns a Net::LDAP::Entry.

handle firebird events asynchronously with perl

I'm creating an info board app with data taken from firebird 1.5 database.
I would like not to use polling but events.
I've created sample trigger which fires up an event in firebird database.
Now I need a client to listen for and handle the event.
I've decided to go with perl.
Here is the doc DBD::Firebird.
I'm trying to go with async events.
Here's the code, I give the skeleton which won't work anyway.
The event won't fire up in perl. What am I doing wrong. Please help, thanks!
#!/usr/bin/perl
use DBI;
$dsn =<< "DSN";
dbi:Firebird:dbname=/home/firebird/dev/db.gdb;
host=localhost;
port=3050;
ib_dialect=3;
DSN
$dbh = DBI->connect($dsn, "user", "password");
# events of interest
#event_names = ("schedule_event");
$evh = $dbh->func(#event_names, 'ib_init_event');
my $cb = sub {.
print "got event";
};
$dbh->func($evh, $cb, 'ib_register_callback');
while (1) {
}
UPDATE:
ok here's the php script I'm going with right now, just leave it here maybe it helps someone:
<?php
declare(ticks = 1);
$username = "user";
$password = "password";
$host = 'localhost:/home/firebird/base/base.gdb';
$sockets = array();
$dbh = ibase_connect($host, $username, $password);
function event_handler($event_name, $link) {
echo $event_name . "\n";
send_message($event_name);
}
# we need to unregister event in firebird before exit
function terminate($signal) {
global $event;
if (is_null($event)) {
die ( "no event has been registered yet, exiting" );
} else {
ibase_free_event_handler($event);
die ( "unregistered evented and exiting\n" );
}
}
function send_message($msg)
{
$localsocket = 'tcp://127.0.0.1:8010';
$instance = stream_socket_client ($localsocket, $errno, $errstr);
fwrite($instance, json_encode(['message' => $msg, 'userId' => 824]) . \n");
}
$event = ibase_set_event_handler($dbh, "event_handler", "schedule_update");
pcntl_signal(SIGTERM, "terminate");
while (true) {
sleep(1);
}
?>

Why is the server returned the result for a different submit than selected by perl HTML::Form and LWP::UserAgent?

I want to process a number of files with http://2struc.cryst.bbk.ac.uk/twostruc; to automate this I wrote a perl script using perl's HTML::Form.
This server has a two step submit process: first, upload a file or enter an id; second, select the methods to be used and the output (by chosing one of five submits).
The first step works, but for the second step I seem to be unable to chose any submit button other than the first, even though my script output confirms that I selected the one I want (different from the first).
The two core parts of the code are below, the request function:
sub create_submit_request
{
my $form_arrayref = shift;
my $form_action = shift;
my $value_hashref = shift;
my $submit_name = shift;
my $submit_index = shift;
my $found_form = 0;
my $form;
foreach my $this_form( #$form_arrayref)
{
printf( "# Found form with action=%s\n", $this_form->action);
if( $this_form->action eq $form_action)
{
$found_form = 1;
$form = $this_form;
}
}
die( "# Error: No form with action $form_action") if( $found_form == 0);
my #inputs = $form->inputs;
my $inputs_string;
foreach my $input( #inputs)
{
my $input_name = defined( $input->name) ? $input->name : "<unnamed_input>";
my $input_value = defined( $input->value) ? $input->value : "";
$inputs_string .= $input_name.( length( $input_value) > 0 ? "=".$input_value : "")." (".$input->type."); ";
}
printf( "# Available input names: %s\n", $inputs_string);
printf( "# Filling in form data\n");
while( my( $key, $value) = each( %$value_hashref))
{
$form->value( $key, $value);
}
my #submit_buttons = $form->find_input( $submit_name, "submit", $submit_index); # 1-based counting for the index
die( "# Error: Can only handle a single submit, but found ".scalar( #submit_buttons)) if( scalar( #submit_buttons) != 1);
my %submit_hash = %{ $submit_buttons[ 0]};
# DEBUG
printf( "# Use submit: %s\n", Data::Dumper->Dump( [ \%submit_hash ]));
return $form->click( %submit_hash);
}
and the code using it:
my $request = HTTP::Request->new( GET => $url_server);
my $response = $useragent->request( $request);
# the first page contains the pdb id input and file upload inputs
my #forms = HTML::Form->parse( $response);
my %value_hash = ( "file" => $pdb_file);
# the submit buttons have no name, use undef; chose the first one (w/o javascript)
$request = create_submit_request( \#forms, $form_action1, \%value_hash, undef, 1);
printf( "# Submitting to server\n");
$response = $useragent->request( $request);
# the first page contains the pdb id input and file upload inputs
#forms = HTML::Form->parse( $response);
%value_hash =( "dsspcont" => "on", "stride" => "on");
# this form has 5 submit buttons; select the 5th
$request = create_submit_request( \#forms, $form_action2, \%value_hash, undef, 5);
printf( "# Submitting to server\n");
$response = $useragent->request( $request);
my $response_content = $response->content;
printf( "# Response content: %s\n", $response_content);
Even though the script prints
# Use submit: $VAR1 = {
'name' => 'function_sequenceStructureAlignment',
'onclick' => 'this.form.target=\'_blank\';return true;',
'type' => 'submit',
'value' => 'Sequence Structure Alignments',
'value_name' => ''
};
which is the 5th submit button in the second step, the response is equivalent to pressing the first submit button.
To test the server itself, the file 1UBI.pdb can be downloaded from http://www.rcsb.org/pdb/files/1UBI.pdb and uploaded to the server. The full script is at http://pastebin.com/bSJLvNfc and can be run with
perl 2struc.pl --pdb 1UBI.pdb
Why is the server returning a different output/submit that I seem to select in the script?
(It seems it's not dependend on cookies, because I can clear them after the first step, and still get the correct result for the second step in a web browser.)
You gave a hash as selector for click, which is wrong (see documentation how to specify the selector). But because you have already found the correct submit element you could simply call click directly on it:
--- orig.pl
+++ fixed.pl
## -87,7 +87,7 ##
# DEBUG
printf( "# Use submit: %s\n", Data::Dumper->Dump( [ \%submit_hash ]));
- return $form->click( %submit_hash);
+ return $submit_buttons[0]->click($form);
}
sub predict_pdb

Perl: Unable to check validity of hostname for Net::Appliance::Session

When I tried to pass an invalid hostname, the code will get into an infinite loop.
my $s = Net::Appliance::Session->new({
personality => 'ios',
transport => 'SSH',
host => $ip
});
Is there a way to overcome this bug?
EDIT:
Here's my full code:
I use the subroutine to download the config file of my network device. When I pass in an invalid IP address in download_config, it will get into an infinite loop.
sub download_config
{
my ($ip) = #_;
my $s = Net::Appliance::Session->new({
personality => 'ios',
transport => 'SSH',
host => $ip,
Timeout => 1
});
$s->set_global_log_at('debug'); # maximum debugging
eval {
$s->connect({ username => $username, password => $password });
$s->begin_privileged({ password => $enable_password });
#get hostname to set the file name
$hostname_result = $s->cmd('sh run | inc hostname');
$hostname_result =~ m/hostname (.*)/;
$hostname = $1;
#download the file
my #running_config = $s->cmd('sh run');
#running_config = #running_config[ 2 .. (#running_config -1)];#remove header and footer of the file
open(FH, "> temp/".$hostname.".txt") or die("Cannot open config file : $!");
print FH #running_config;
close FH;
$s->end_privileged;
};
if ($#) {
#when the login details are wrong
print redirect('../../na/unauthorised.html');
}
$s->close;
}
The developer has fixed the bug.
Are you sure?
Are you tried this example code with your host name?
http://cpansearch.perl.org/src/OLIVER/Net-Appliance-Session-3.120560/examples/example-1.pl
If yes, you could create an RT ticket or you could try to contact the author.
I have chacked the code, and did not found anything (too) nasty.
Regards,

Perl SSH connection to execute telnet

I tried the following to access a router via a central admin server as "ssh hop" server
#!/usr/bin/perl -X
use strict;
use Net::OpenSSH;
use Net::Telnet;
my $lhost = "linuxserver";
my $luser = "linuxuser";
my $lpass = "linuxpassword";
my $chost = "routername";
my $cpass = "Routerpassword";
my $prompt = '/(?:Password: |[>])/m';
my #commands = ("show users\r");
my $ssh = Net::OpenSSH->new($lhost,
'user' => $luser,
'password' => $lpass,
'master_opts' => [ '-t' ],
#'async' => 1 # if enabled then password cannot be set here
);
my ($pty, $err, $pid) = $ssh->open2pty("telnet $chost");
my $t = new Net::Telnet(
-telnetmode => 0,
-fhopen => $pty,
-prompt => $prompt,
-cmd_remove_mode => 1,
-output_record_separator => "\r",
#-dump_log => "debug.log",
);
my $end = 0;
while (!$end) {
my ($pre, $post) = $t->waitfor($prompt);
if ($post =~ /Password: /m) {
# send password
$t->print("$cpass");
}
elsif ($post =~ /[>#]/ && #commands) {
my $cmd = shift(#commands);
if ($cmd !~ /[\r\n]/) {
$t->print($cmd);
}
else {
print $t->cmd($cmd);
}
}
else {
$end = 1;
$t->cmd("exit");
}
}
#close $pty;
$t->close();
Unfortunately I always get the following error:
read error: Input/output error at test.pl line 71
Can somebody help me please or is there a better solution only to test if a telnet connection via the "hop" server is possible or not?
The connection looks like:
workstation --ssh-> server --telnet-> router
Thanks in advance.
I think best option is to make an SSH-tunnel to your admin server and use it for telnetting to the router.
Getting Net::Telnet to work over Net::OpenSSH sometimes is not as easy as it should be and it requires some experimentation to get to the right combination of flags and calls that make it work.
For instance, instead of telneting to the target host, use netcat to open a raw connection (or Net::OpenSSH support for TCP forwarding if tunnels are allowed on the proxy).
Expect + Net::OpenSSH may be a better option.