Just trying to connect a database with multiple connection strings with different passwords. The passwords have different privileges. If one password fails, it should try with another one.
The code has been written as below. Though it works fine, how can we refactor code (eval & DBH) to handle multiple connection strings?
my %config = do 'dbconfig.pl';
my $dbh = eval { DBI->connect("dbi:Pg:dbname=".$config{db}.";host=$socket_nm;port=".$config{port}."", $config{user},$config{password},{RaiseError=>1,PrintError=>0}) };
if (!$dbh) {
$dbh = eval { DBI->connect("dbi:Pg:dbname=".$config{db}.";host=$socket_nm;port=".$config{port}."",$config{user},$config{password},{RaiseError=>1,PrintError=>0}) };
}
if ( $# ) {
#Handle Exceptions
}
dbconfig.pl contains :
db => 'db',
port => '5432',
user => 'db_ro',
password => 'Pass01',
password2 => 'Pass02'
You need to use a loop and retry until you get a working connection. In each loop, you need to grab the next set of config values and try to connect with it.
my #configs = (
{
# ...
user => 'user1',
password => 'password1',
},
{
# ...
user => 'user2',
password => 'password2',
},
);
my $dbh;
while ( not $dbh ) {
my $config = shift #configs; # grab the next config
if ( not $config ) {
# we ran out of configs to try
die "Couldn't connect to database";
}
# try the config
$dbh = eval {
DBI->connect(
"dbi:Pg:dbname=" . $config->{db} . ";host=$socket_nm;port=" . $config->{port} . "",
$config->{user}, $config->{password}, { RaiseError => 1, PrintError => 0 } );
};
# we don't need to look at $# here, but if we care we can still do it
}
The configs are now stored in an array #configs. Inside, there are hash references. In your loop we have a lexical $config, which contains the current one we want to try. Note that this also is a hash reference, so the you need to use $config->{...} with the arrow in the dsn.
We loop as long as $dbh is not set. That's the case until the eval inside of the loop returns a working database handle object.
We also need to exit the loop if we run out of configs. Dying seemed like a good idea for that.
If you want, you can handle the errors that eval is catching for you, but for this to work you don't have to do it. If you all you care about is that you get a working connection in the end, this should be sufficient.
Note: Your %config = do 'dbconfig.pl' is horrible. Please use a proper config file format like JSON and a module to read it. I really like Config::ZOMG as it supports lots of different formats and lets you combine multiple files into one config hash. But Config::Simple might be enough for you here.
Related
I'm working on moving a Perl script that pushed commands to routers. We have turned off telnet, so I'm working on getting SSH to work. After looking at a number of SSH libraries in Perl, I've opted to use Net::OpenSSH. I have no problem logging in and passing commands to the routers, but the problem I'm having is with entering config mode and subsequently passing a command.
The problem is that with each command entered, the underlying system appears to logout then reenter with the next subsequent command. For example with a Juniper router I'm trying to do the following:
edit private
set interfaces xe-1/3/2 description "AVAIL: SOMETHING GOES HERE"
commit
exit
quit
Tailing the syslog from the router I'm seeing something like this...
(...)
UI_LOGIN_EVENT: User 'tools' login, class 'j-remote-user' [65151], ssh-connection 'xxx.xxx.xxx.xxx 42247 xxx.xxx.xxx.xxx 22', client-mode 'cli'
UI_CMDLINE_READ_LINE: User 'tools', command 'edit private '
UI_DBASE_LOGIN_EVENT: User 'tools' entering configuration mode
UI_DBASE_LOGOUT_EVENT: User 'tools' exiting configuration mode
UI_LOGOUT_EVENT: User 'tools' logout
UI_AUTH_EVENT: Authenticated user 'remote' at permission level 'j-remote-user'
UI_LOGIN_EVENT: User 'tools' login, class 'j-remote-user' [65153], ssh-connection 'xxx.xxx.xxx.xxx 42247 xxx.xxx.xxx.xxx 22', client-mode 'cli'
UI_CMDLINE_READ_LINE: User 'tools', command 'set interfaces '
UI_LOGOUT_EVENT: User 'tools' logout
(...)
As you notice I'm getting a LOGOUT_EVENT after each command entered. Of course exiting config mode immediately after entering it causes the set interfaces command to fail as it's no longer in config mode.
The Perl code I'm using is as follows...
#!/usr/bin/perl -w
use strict;
use lib qw(
/usr/local/admin/protect/perl
/usr/local/admin/protect/perl/share/perl/5.10.1
);
use Net::OpenSSH;
my $hostname = "XXXXX";
my $username = "tools";
my $password = "XXXXX";
my $timeout = 60;
my $cmd1 = "edit private";
my $cmd2 = 'set interfaces xe-1/3/2 description "AVAIL: SOMETHING GOES HERE"';
my $cmd3 = "commit";
my $cmd4 = "exit";
my $ssh = Net::OpenSSH->new($hostname, user => $username, password => $password, timeout => $timeout,
master_opts => [-o => "StrictHostKeyChecking=no"]);
$ssh->error and die "Unable to connect to remote host: " . $ssh->error;
my #lines = eval { $ssh->capture($cmd1) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd2) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd3) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd4) };
foreach (#lines) {
print $_;
};
$ssh->system("quit");
The sequence of events is the same as when telnet was used. The only real change was in using SSH objects verses Telnet objects. I'm stumped. Any ideas you could provide would be quite helpful.
[SOLVED, sort of]
The suggestion let Net::Telnet do the driving was the correct one. The following code works...
#!/usr/bin/perl -w
use strict;
use Net::OpenSSH;
use Net::Telnet;
use Data::Dumper;
my $promptEnd = '/\w+[\$\%\#\>]\s{0,1}$/o';
my $cmd1 = "show system uptime | no-more";
my $cmd2 = "show version brief | no-more";
my $hostname = "xxx.xxx";
my $username = "xxxxxxx";
my $password = "xxxxxxx";
my $timeout = 60;
my $ssh = Net::OpenSSH->new(
$hostname,
user => $username,
password => $password,
timeout => $timeout,
master_opts => [ -o => "StrictHostKeyChecking=no" ]
);
$ssh->error and die "Unable to connect to remote host: " . $ssh->error;
my ( $fh, $pid ) = $ssh->open2pty( { stderr_to_stdout => 1 } );
my %params = (
fhopen => $fh,
timeout => $timeout,
errmode => 'return',
);
$conn = Net::Telnet->new(%params);
$conn->waitfor($promptEnd);
#lines = $conn->cmd($cmd1);
foreach (#lines) {
print $_;
}
#lines = $conn->cmd($cmd2);
foreach (#lines) {
print $_;
}
$conn->cmd("quit");
The problem I'm having is that I can't seem to separate the code into subroutines. Once the $conn object is returned from a subroutine, the underlying ssh connection drops. I need to separate this logic in order to not have to rewrite many, many programs and lines of code that relay on this pusher routine. However that problem I'll direct to another question.
[Edit, fully solved]
Just an update in case anyone needs to do something similar.
While the above worked very well when run under a single subroutine, I found that any time I passed the handle to another subroutine, the telnet handle remained open, but the ssh connection dropped.
To solve this I found that if I passed the ssh handle to another subroutine, then later attached the open2pty, and attached Net::Telnet, then I could pass the Net::Telnet handle between subroutines without the underlying ssh connection dropping. This also worked for Net::Telnet::Cisco as well. I have this code working well with Cisco, Juniper, and Brocade routers.
You should also consider adding a few more parameters to the Net::Telnet->new() because it is interacting with ssh rather than a TELNET server.
-telnetmode => 0
-output_record_separator => "\r",
-cmd_remove_mode => 1,
Because there is no TELNET server on remote side, -telnetmode => 0 turns off TELNET negotiation.
The end-of-line is most likely just a carriage-return (i.e. -output_record_separator => "\r") rather than the TCP or TELNET combination of carriage-return linefeed ("\r\n").
Always strip the echoed back input -cmd_remove_mode => 1
There are several possibilities:
Some routers accept having the sequence of commands sent up front via stdin:
my $out = $ssh->capture({stdin_data => join("\r\n", #cmds, '')})
In other cases you will have to use something like Expect to send a command, wait for the prompt to appear again, send another command, etc.
If you were using Net::Telnet before, the Net::OpenSSH docs explain how to integrate both (though I have to admit that combination is not very tested).
Also, some routers provide some way to escape to a full Unix-like shell. I.e., preppending the commands with a bang:
$ssh->capture("!ls");
I can successfully create a connection to a Postgres db using the following:
my $settings = {
host => 'myhost',
db => 'mydb',
user => 'myuser',
passwd => 'mypasswd'
};
my $connection = DBI->connect(
'DBI:Pg:dbname=' . $settings->{'db'} . ';host=' . $settings->{'host'},
$settings->{'user'},
$settings->{'passwd'},
{
RaiseError => 1,
ShowErrorStatement => 0,
AutoCommit => 0
}
) or die DBI->errstr;
But I'm left with valuable login credentials exposed (yes, I changed them) in my Perl module. Currently, I use psql to issue queries interactively. And to save on having to remember my username/password, I have placed the credentials in a file (~/.pgpass) with permissions 600. The file looks like this:
# host:port:database:user:passwd
myhost:5432:mydb:myuser:mypasswd
How can I safely use this file ("$ENV{HOME}/.pgpass") and the DBI module to hide my credentials? Can it be done? What is best practice?
YES! There IS a better way.
Change between test & live servers easily.
keep passwords in ~/.pgpass (for psql & pg_dump)
other config info in ~/.pg_service.conf (or /etc/pg_service.conf)
e.g:
#!/usr/bin/perl -T
use strict;
use warnings;
use DBI;
my $dbh = DBI->connect
(
#"dbi:Pg:service=live",
"dbi:Pg:service=test",
undef,
undef,
{
AutoCommit => 0,
RaiseError => 1,
PrintError => 0
}
) or die DBI->errstr;
~/.pg_service.conf:
# http://www.postgresql.org/docs/9.2/static/libpq-pgservice.html
# /usr/local/share/postgresql/pg_service.conf.sample
# http://search.cpan.org/dist/DBD-Pg/Pg.pm
#
[test]
dbname=hotapp_test
user=hotusr_test
# localhost, no TCP nonsense needed:
host=/tmp
[live]
dbname=hotapp_live
user=hotusr_live
host=pgsql-server.example.org
~/.pgpass:
# http://www.postgresql.org/docs/9.2/static/libpq-pgpass.html
# hostname:port:database:username:password
localhost:5432:hotapp_test:hotusr_test:kq[O2Px7=g1
pgsql-server.example.org:5432:hotapp_live:hotusr_live:Unm£a7D(H
Put your login credentials in a file called ~/.pgpass as per the question above.
To open a connection, you'll need to hard-code in the host, database and username. But that's ok, because at least you don't need to code in the password field. This field stays hidden in your ~/.pgpass file.
Make sure to set the connection instance's password field to undef.
Here's what worked for me:
my $settings = {
host => 'myhost',
db => 'mydb',
user => 'myuser'
};
my $connection = DBI->connect(
'DBI:Pg:dbname=' . $settings->{'db'} . ';host=' . $settings->{'host'},
$settings->{'user'},
undef,
{
RaiseError => 1,
ShowErrorStatement => 0,
AutoCommit => 0
}
) or die DBI->errstr;
The connections establishes successfully because for some reason, unknown to me at least, the instance searches the ~/.pgpass file when attempting the connection. I knew there was some magic with this file, I was just unsure about what to do with it. Doc link:
http://search.cpan.org/dist/DBI/DBI.pm#data_string_diff
Notice how a search for "pgpass" on that page does not return? And I refuse to read all of it. Well, one day maybe..
open(my $fh, '<', "$ENV{HOME}/.pgpass") or die $!;
my $settings;
while (<>) {
chomp;
next if /^\s*(?:#.*)?\z/s;
#{$settings}{qw( host port database user passwd )} = split /:/;
}
die "No settings" if !$settings;
Any user capable of running the script would still be able to see the creds.
I'm trying to use the AnyEvent::Twitter::Stream module and I want to reference a file that lists the Twitter uids I want to follow. I can put the uids in the code itself and it works as follows:
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => '15855509,14760150,18598536',
on_tweet => sub {
#some code.....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
But when I try to do the same using a file as such:
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
open UID_FILE, "/tmp/uids" or die $!;
my #uid_line = <UID_FILE>;
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => #uid_file,
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
it fails. The uids file has the following contents:
'15855509,14760150,18598536'
I'm getting a 406 error from Twitter, suggesting the format is not correct. I'm guessing the quotes are not correct somehow?
The AnyEvent::Twitter::Stream module subclasses AnyEvent and you don't need to access the base module at all. All the functionality is provided by the new method and the callbacks that you specify there, and you shouldn't call AnyEvent->condvar or $done->recv.
The open call and assignment to #uid_line don't belong inside the call to AnyEvent::Twitter::Stream->new.
Furthermore the variable you are using to supply the value for the follow parameter is #uid_file instead of #uid_line.
You must use strict; and use warnings; at the start of your programs, especially if you are asking for help with them. This will trap simple mistakes like this that you could otherwise overlook.
You can't in general use an array to supply a single scalar value. In this instance it may be OK as long as the file has only a single line (so there is only one element in the array) but there is a lot that could go wrong.
In addition you are passing single-quotes in the value that don't belong there: they appear in the code only to mark the start and end of the Perl string.
I suggest you read all decimal strings from your file like this
open my $uid_fh, '<', '/tmp/uids' or die $!;
my #uids;
push #uids, /\d+/g for <$uid_fh>;
(Note that these lines belong before the call to AnyEvent::Twitter::Stream->new)
Then you can supply the follow parameter by writing
follow => join(',', #uids),
I hope this is clear. Please ask again if you need further help.
Edit
These changes incorporated into your code should look like this, but it is incomplete and I cannot guarantee that it will work properly.
use strict;
use warnings;
use AnyEvent::Twitter::Stream;
open my $uid_fh, '<', '/tmp/uids' or die $!;
my #uids;
push #uids, /\d+/g for <$uid_fh>;
my %cf = (
account => 'myaccount',
password => 'password',
);
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => join(',', #uids),
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
It looks to me like you are trying to pass an array in a scalar context so it is possible that you are setting follow to 1, the number of elements in the array (the number of lines in the file).
Assuming there is only a single line of IDs in your file, does the following work:
open UID_FILE, "/tmp/uids" or die $!;
# Load the first line of uids
my $uid_line = <UID_FILE>;
# Remove apostrophes from input.
# This may or may not be necessary
$uid_line =~ s/'//g;
# Don't forget to close the file
close(UID_FILE);
my $done = AnyEvent->condvar;
my $nt_filter = AnyEvent::Twitter::Stream->new(
username => $cf{account},
password => $cf{password},
method => 'filter',
follow => $uid_line,
on_tweet => sub {
#some code....
},
on_error => sub {
my $error = shift;
debug "ERROR: $error";
},
timeout => 45,
);
$done->recv;
You will probably need to strip the leading and trailing apostrophes from your input line. For example:
$uid_line =~ s/^'//;
$uid_line =~ s/'$//;
You could probably get away with just removing all apostrophes, e.g.:
$uid_line =~ s/'//g;
This question already has answers here:
Closed 12 years ago.
Possible Duplicate:
error of importing DBI in Perl
I have a problem when I use the DBI module in another module, script.pm.
package CC;
use DBI;
use strict;
use Alias;
my $dbFile = 'XXXXXXXX.db';
my $db = DBI->connect("dbi:SQLite:$dbFile","","",
{RaiseError =>1, AutoCommit => 1})or "Unable to connect: $DBI::errstr\n";
use Alias qw(attr);
our ($CURRENTOFFSET,#LANGUAGE);
sub new {
my $that = shift;
my $class = ref($that)|| $that;
my $self = {
CURRENTOFFSET=> undef,
LANGUAGE => []
};
bless($self, $class);
return $self;
}
Substantive
Conventionally, a package XYZ is kept in a file XYZ.pm; Perl won't find your package otherwise. Thus, your file should be CC.pm rather than script.pm.
Note that a package Organization::Team::Purpose is kept in a file Purpose.pm, but the file is kept in a sub-directory Organization/Team and the base directory holding Organization has to be found by Perl (using -I/some/where if Organization is a sub-directory of the directory /some/where, for example; if it is a sub-directory of the current directory, it will be found anyway).
You should probably review the or clause after your connection attempt. Normally, you do a die or croak there. You simply evaluate a string, which is not very useful.
You have:
my $db = DBI->connect("dbi:SQLite:$dbFile","","",
{RaiseError =>1, AutoCommit => 1})or "Unable to connect: $DBI::errstr\n";
You should consider what to do, but one technique is:
use Carp;
my $db = DBI->connect("dbi:SQLite:$dbFile", "", "",
{ RaiseError => 1, AutoCommit => 1 })
or croak "Unable to connect: $DBI::errstr\n";
The downside of that is that this is going into a module, and it isn't necessarily a good idea to croak in the BEGIN code of a module (and I'm making an assumption that the code is executed as the module is loaded). You might need to store the undef database handle and protect other methods from using it. You might be better off deferring the 'connect to database' operation until the constructor new is used (possibly for the first time). It is at least legitimate to raise errors at that point.
As the answer by DVK noted (before I wrote my answer), modules should end with 1; to indicate successful loading. Maybe you can exploit that to report an error on failure to load - the final condition might be 'defined $db ? 0 : 1;' (or even just 'defined $db;'), but it would be crucial to generate an error message somehow to explain the problem.
Trivia
You should be ruthlessly consistent in the spacing around operators, too. Your example includes:
{RaiseError =>1, AutoCommit => 1}
my $class = ref($that)|| $that;
CURRENTOFFSET=> undef,
which would be better written as:
{RaiseError => 1, AutoCommit => 1}
my $class = ref($that) || $that;
CURRENTOFFSET => undef,
The first might benefit from a little more space:
{ RaiseError => 1, AutoCommit => 1 }
It doesn't directly affect the operation of the code. It does make it a little less easy to read. Learning to be consistent is an important part of learning to program.
Judging by the fact that this is a package, and your code sample doesn't end with "1;", try adding a last line to your .pm file as follows:
1;
Perl modules must return a true value upon evaluation via do, to be loaded successfully via use or require:
The file must return true as the last statement to indicate successful execution of any initialization code, so it's customary to end such a file with 1; unless you're sure it'll return true otherwise. But it's better just to put the 1; , in case you add more statements.
I am trying to setup a basic error checking system where it will catch shell errors run by a system call. execute_command is a webmin function that runs a system call and then sets an error message to its 4th parameter. I basically call execute_command_error("adduser test"), knowing that I already have a user called test created and based on my predefined arrays, id expect it to print
Unable to add userUnable to
add that user because it already
exists on the system.
but instead I get:
Uhhhhhhhhh? Uhhhhhhhhh?
I have verified that $exe and $return are "adduser" and 1, respectifully.
What am I not understanding about arrays? It seems to ignore the string and or number and just go by the last definition with 3 elements. What is a solution to this, or a better solution?
Here is ths code:
$ErrorMsg['adduser',1,'title'] = "Unable to add user";
$ErrorMsg['adduser',1,'msg'] = "Unable to add that user because it already exists on the system.";
$ErrorMsg['random',2,'duaisdhai'] = "Uhhhhhhhhh?";
sub execute_command_error
{
my $error = "";
my $cmd = $_[0];
$return = execute_command($cmd, undef, undef, \$error)>>8;
if ($error) {
my ($exe) = $cmd =~ m|^(.*?)[ ]|;
$exe_title = $ErrorMsg[$exe,$return,'title'];
$exe_msg = $ErrorMsg[$exe,$return,'msg'];
print $exe_title."<br>";
print $exe_msg ."<br>";
}
}
Update:
I am thinking that I need to use hashes, I have no idea why I thought I could use strings in indices. With that said, little research has led me to something like this:
%ErrorMsgs = ('adduser' => {
'1' => {
'title' => 'Unable to add user',
'msg' => 'Unable to add that user because it already exists on the system.',
},
},
);
Now how would I reference it using a variable? because neither of these work:
$exe_title = $ErrorMsgs{"$exe"}{"$return"}{"title"};
$exe_title = $ErrorMsgs{$exe}{$return}{title};
First, see perldsc for the proper syntax for doing multidimensional structures. Your arrays don't make any sense.
If you had warnings turned on, you would have seen a "Argument isn't numeric" warning to tell you that you can't use strings in any meaningful way in an array index.
But the hash you posted in your update should work fine.
#!/usr/bin/perl
use strict;
use warnings;
## ^^ these things are your friends
my %ErrorMsgs = ('adduser' => {
'1' => {
'title' => 'Unable to add user',
'msg' => 'Unable to add that user because it already exists on the system.',
},
},
);
my $exe = 'adduser';
my $return = 1;
print $ErrorMsgs{$exe}{$return}{title}; # works
If you're not getting the output you expect, it's because there's something wrong with $exe or $return -- they might not be defined in the scope where you're trying to use them. Turning on strict and warnings will help track the issue down.
{ 'key' => 'val' } creates a hash reference, so you dereference before looking up a key.
$exe_title = $ErrorMsgs{$exe}->{$return}->{"title"};
You also don't need to quote $exe or $return, since these already hold strings.
Note that Perl doesn't support multidimensional indices; a multidimensional array is just an array of arrays, so you need to use [] for each index. In scalar context, the comma operator returns the value of the rightmost expression, so the following lines are equivalent:
$ErrorMsg[0,1,2] = "foo";
$ErrorMsg[2] = "foo";
Note that in list context, the comma operator returns a list of values, which gives us slices:
#a=qw(f o o);
#a[3,4,5] = qw(b a r);
print join(',', #a), "\n";
# output: f,o,o,b,a,r
#ErrMsg{qw(title msg)} = ('Unable to add user', 'Unable to add that user because it already exists on the system.')