using Net::SSH::Expect within a thread fails
Hello,
I'm having problems with the following code. It is supposed to get a
list of IP addresses from the IAD module and then create a few threads
to each log into those devices and make changes in the config. The
only device that is allowed to access the devices I'm configuring is
the 'manage.example.com'. From there, the threads will telnet to the
devices and make whatever changes need to be made.
---start---
#!/usr/local/bin/perl
# be safe, not stupid
use strict;
use warnings;
# include the code to generate the list of IPs
use IAD;
# check to ensure that we're threadable
use Config;
$Config{useithreads} or die('Recompile Perl with threads to run this program.');
# include the thread stuff
use threads;
use Thread::Queue;
use Thread::Semaphore;
# include the ssh stuff
use Net::SSH::Expect;
use Term::ReadPassword;
# get the username/password
my $exe_user = get_exe_user();
my $exe_pass = get_exe_pass();
# set up changes to be made
my $TheChange = get_input();
# set up param list
my @paramlist = ($TheChange, $exe_user, $exe_pass);
my $semaphore = Thread::Semaphore-new(3); # can only make three
connections to the management server at a time
my $DataQueue = Thread::Queue-new();
my $thread1 = threads-create(\threadsub, @paramlist);
my $thread2 = threads-create(\threadsub, @paramlist);
my $thread3 = threads-create(\threadsub, @paramlist);
my $iad = IAD-new();
$DataQueue-enqueue(@{$iad-iads()});# $iad-iads() returns a
reference to a list of IP addresses to manage
$DataQueue-enqueue(DIE, DIE, DIE);
$thread1-join();
$thread2-join();
$thread3-join();
exit;
sub threadsub {
#threads-detach();
my $code = shift;
my $exe_user = shift;
my $exe_pass = shift;
my $threadNumber = threads-tid();
# create the ssh object
my $ssh = Net::SSH::Expect-new (
host = 'manage.example.com',
user = $exe_user,
password = $exe_pass,
raw_pty = 1
);
# login to management server
my $login_output = $ssh-login(); this is line 65
if ($login_output !~ /home]$/) {
die Login has failed. Login output was $login_output;
}
while (my $DataElement = $DataQueue-dequeue()) {
last if ($DataElement eq DIE);
$semaphore-down();
print(Thread $threadNumber got $DataElement\n);
# $ssh-exec(telnet $DataElement, 10);
# print $ssh-exec($code);
# $ssh-exec(exit);
#sleep(1);
$semaphore-up();
}
return;# Thread $threadNumber is dying!\n;
}
sub get_input {
print Please enter commands below (end with a . on a line by
itself)\n;
my $retval = '';
while (defined(my $line = STDIN)) {
last if ($line eq .\n);
$retval .= $line;
}
return $retval;
}
sub get_exe_user {
print Please enter management username: ;
my $user = ;
chomp($user);
return $user;
}
sub get_exe_pass {
# get password from user
my $password = read_password('Password: ');
return $password;
}
---end---
However, When I try connecting, I get the following example output.
This is my first time writing threaded programs, so if I'm doing
anything wrong or inefficiently, please let me know since this program
will make a lot of connections once it's up and running. Thanks for
any help you can provide!
---start-output---
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied (publickey,password).
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied, please try again.
ssh_askpass: exec(/usr/local/bin/ssh-askpass): No such file or directory
Permission denied (publickey,password).
Permission denied (publickey,password).
thread failed to start: SSHConnectionAborted at ./test_threads.pl line 65
thread failed to start: SSHConnectionAborted at ./test_threads.pl line 65
thread failed to start: SSHConnectionAborted at ./test_threads.pl line 65
---end-output---
--
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: help me die verbosely
Chas. Owens wrote:
On Jan 17, 2008 9:54 AM, Jonathan Mast [EMAIL PROTECTED] wrote:
I want to write the errors caught by a 'die' clause into a file.
snip
Try
#!/usr/bin/perl
use strict;
use warnings;
$SIG{__DIE__} = sub {
open my $fh, , something.log
or die @_, could not open something.log: $!;
print $fh @_;
};
die Oops;
Would this not be susceptible to infinite recursion if it fails to open
something.log? Would it not be safer/better to do something like this
(untested)?
#!/usr/bin/perl
use strict;
use warnings;
sub myDie {
open my $fh, , something.log
or die @_, Could not open something.log: $!;
print $fh @_;
exit 1;
}
myDie Oops;
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Comparing Regular Expression in Perl vs Python
Michael Gale wrote: Hey, I have done some scripts in python, I found it easy to use and quick. I found I could recreate some apps faster in python however I found that the regular expression usage in python does not match perl's. I agree, regexp usage in python is quite clunky compared to perl. However, I do a lot of work in python so I'm pretty comfortable in either. If you're going to be doing a lot of regexp work and already know how to do it in perl, I'd recommend that you just stick with perl for your main work. One thing that python does quite well that I have yet to see done to my satisfaction in perl is exception handling, but if you write good code, you shouldn't need to worry about that anyway ;-) So it depends on what you are doing. Michael BTW, please don't top-post. difficult more threads the reading makes it. JBallinger wrote: Hi, I recently heard about Python. They claimed that it is easier to learn and to program in Python than in Perl. Most of my work is relating to transformation of one text file format to another. Therefore, I wonder whether anyone has experience doing this in Python; and does what they claimed is true? Thanks, JBB -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: premature end of header script error
Ankur wrote: Hi, I am receiving the following error : Premature end of script headers when running my CGI script using a web browser. Instead if I execute the script manually at the shell, it executes successfully. Actually, the script needs to fetch a lot of data from the database. Whenever a cgi works from the shell but not from the browser, the first thing I'd check is any environment variable your scipt might be affected by. I couldn't find any related reference for this error description on the web, though there are a lot of other references. Any idea? Ankur Jain -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: AFAIK
Somu wrote: What does it mean? AFAIK? I have seeing it a lot.. Earlier i've been seeing the HTH, and a guess gave the answer.. But this one, AFAIK... Are there any more such short forms? As far as I know Hope that helps! http://www.ucandoit.org.uk/knowledgebase/webacronyms.html -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: library (random numberS)
On 7/27/07, yitzle [EMAIL PROTECTED] wrote:
I was under the impression that average meant mean.
correct. Average is the common term for mean. In fact, reading the
pages linked above, they do imply (without stating explicitly) that
the three terms describe different calculations.
I can't think of any situation where someone has said average and
meant mode or median.
sub sumIt(@)
{
my $total = 0;
$total += $_ for (@_);
return $total; # This line might not be needed...
}
sub avg(@)
{
my @arr = @_;
my $arrSize = @arr; # scalar(@arr) is the array size - or one less
(last index). Double check
return simIt(@arr) / $arrSize;
}
1;
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
--
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Unable to store the output of a command
On 5/18/07, divya [EMAIL PROTECTED] wrote: Hi, I want to store the output of following command: vcover merge outfile in1 in2 I tried : 1) @result = `vcover merge outfile in1 in2`; 2) system(vcover merge outfile in1 in2 @result); I can see some error displays on the screen. But these are not getting stored in @result. backticks (``) will direct the STDOUT of the command to the array. However, your STDERR will not be directed normally. If you want those errors directed into your array, try something like @result = `vcover merge outfile in1 in2 21`; Kindly please suggest some way to store it. NOTE : script runs on linux m/c Thanks, Divya -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: pass variable to another program
On 5/17/07, Brian Volk [EMAIL PROTECTED] wrote: Hello, Is there a way to pass a variable from one program to another? I have a web site that allows the user to set the time they would like to download a file... The program uses the Linux at command and launches another perl program that does the actual FTP download. I would like to pass a parm variable (email address) from the web site, captured in the first perl program to the second perl program. Is this possible? I don't know of a way to directly pass a variable from one script to another. However, you could easily enough pass it in as a command line argument. Call the second script like perl /path/to/script2.pl variable And in script two, do something like my $argument = shift | die no argument given; I'm sure TIMTOWTDI though. First program uses this line to queue the job system /usr/bin/at $hour:$minute $tod today /var/www/cgi-bin/images; images is a text file containing the perl program that runs the FTP download: perl /var/www/cgi-bin/get_image_file.pl Is there a way to pass a variable from program 1 to program 2? Thanks for your help!! Brian Volk -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: Bandwidth Generated
On 4/13/07, oryann9 [EMAIL PROTECTED] wrote:
It works fine with 5.8.8 on my Fedora Core 5:
$ perl -e 'for (,abc\n,def,hij\n){print;
warn tell STDOUT,\n}'
0
abc
4
7
defhij
11
$
Does not seem to be accurate on this platform???
$ uname -a
CYGWIN_NT-5.1 dubmdsmith10 1.5.24(0.156/4/2)
2007-01-31 10:57 i686 Cygwin
$ perl -e 'for (,abc\n,def,hij\n){print; warn
tell STDOUT,\n };'
-1
abc
-1
-1
defhij
-1
nor here.
[EMAIL PROTECTED] ~]$ uname -a
FreeBSD zeus.agreenftp.no-ip.com 6.2-STABLE FreeBSD 6.2-STABLE #0: Sat
Mar 31 23:12:40 EDT 2007
[EMAIL PROTECTED]:/usr/obj/usr/src/sys/ZEUS i386
[EMAIL PROTECTED] ~]$ perl -e 'for (,abc\n,def,hij\n){print; warn
tell STDOUT,\n };'
2092
abc
2101
2109
defhij
2118
__
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
--
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: cannot determine peer address with Unix domain sockets
On 3/22/07, Tom Phoenix [EMAIL PROTECTED] wrote: On 3/22/07, Andy Greenwood [EMAIL PROTECTED] wrote: $Select = new IO::Select(); Is $Select a global variable? Is that why it's got a capital letter? I suspect that you're not coding under the rules of 'use strict'. I'm $Select is global and I am using strict and warnings. It is declared at the top of the program and defined in the socketinitialize sub. Besides, if it wasn't global, wouldn't I be unable to read from it at all in the checkconnections sub? I can read the list of sockets out of select. Otherwise, perl would never get down to line 1256 and I would never get my error, no? If you want to view the entire script, you can at http://svn.berlios.de/wsvn/tf-b4rt/trunk/html/bin/fluxd/fluxd.pl?op=filerev=0sc=0 It's a little long to post in an email ;-) not sure whether that indicates a problem with your program, but it bears further investigation. Cheers! --Tom Phoenix Stonehenge Perl Training -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: cannot determine peer address with Unix domain sockets
On 3/23/07, John W. Krahn [EMAIL PROTECTED] wrote: Andy Greenwood wrote: On 3/22/07, Tom Phoenix [EMAIL PROTECTED] wrote: On 3/22/07, Andy Greenwood [EMAIL PROTECTED] wrote: $Select = new IO::Select(); Is $Select a global variable? Is that why it's got a capital letter? I suspect that you're not coding under the rules of 'use strict'. I'm $Select is global and I am using strict and warnings. It is declared at the top of the program and defined in the socketinitialize sub. Besides, if it wasn't global, wouldn't I be unable to read from it at all in the checkconnections sub? I can read the list of sockets out of select. Otherwise, perl would never get down to line 1256 and I would never get my error, no? If you want to view the entire script, you can at http://svn.berlios.de/wsvn/tf-b4rt/trunk/html/bin/fluxd/fluxd.pl?op=filerev=0sc=0 It's a little long to post in an email ;-) No offence, but was that translated from VisualBasic? :-( none taken and no. John -- Perl isn't a toolbox, but a small machine shop where you can special-order certain sorts of tools at low cost and in short order. -- Larry Wall -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
cannot determine peer address with Unix domain sockets
I am getting the following error whenever I try to send data to a unix domain socket. PHP sends the command just fine, but perl dies as soon as it reads from the socket. send: Cannot determine peer address at myscript.pl line 1256 I found the following page which discusses a fix for this on OpenBSD. I am using FreeBSD and tried to apply the fix, but no dice. http://www.nntp.perl.org/group/perl.perl5.porters/2007/02/msg121151.html -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: cannot determine peer address with Unix domain sockets
On 3/22/07, Tom Phoenix [EMAIL PROTECTED] wrote:
On 3/22/07, Andy Greenwood [EMAIL PROTECTED] wrote:
I am getting the following error whenever I try to send data to a unix
domain socket. PHP sends the command just fine, but perl dies as soon
as it reads from the socket.
Are you using PHP, or Perl? Both?
Both. perl acts as a daemon and php the interface
here's the php code. I don't belive this is buggy, since it gives no
errors, but I haven't ruled it completely out.
--begin php
function instance_sendCommand($command, $read = 0) {
if ($this-state == FLUXD_STATE_RUNNING) {
// create socket
$socket = -1;
$socket = @socket_create(AF_UNIX, SOCK_STREAM, 0);
if ($socket 0) {
array_push($this-messages , socket_create() failed:
reason: [EMAIL PROTECTED]($socket));
$this-state = FLUXD_STATE_ERROR;
return null;
}
//timeout after n seconds
@socket_set_option($socket, SOL_SOCKET, SO_RCVTIMEO,
array('sec' = $this-_socketTimeout, 'usec' = 0));
// connect
$result = -1;
$result = @socket_connect($socket, $this-_pathSocket);
if ($result 0) {
array_push($this-messages , socket_connect() failed:
reason: [EMAIL PROTECTED]($result));
$this-state = FLUXD_STATE_ERROR;
return null;
}
// write command
@socket_write($socket, $command.\n);
// read retval
$return = ;
if ($read != 0) {
do {
// read data
$data = @socket_read($socket,
4096, PHP_BINARY_READ);
$return .= $data;
} while (isset($data) ($data != ));
}
// close socket
@socket_close($socket);
// return
return $return;
} else { // fluxd not running
return null;
}
}
end php
here's the perl code which creates and reads the sockets
--begin perl---
sub socketInitialize {
$SERVER = IO::Socket::UNIX-new(
Type= IO::Socket::UNIX-SOCK_STREAM,
Local = $PATH_SOCKET,
Listen = 16,
Reuse = 1,
);
# check socket
unless ($SERVER) {
printError(CORE, could not create socket: .$!.\n);
exit;
}
# print
if ($LOGLEVEL 0) {
printMessage(CORE, created socket .$PATH_SOCKET.\n);
}
# create select
$Select = new IO::Select();
# Add our server socket to the select read set.
$Select-add($SERVER);
}
sub checkConnections {
# Get the readable handles. timeout is 0, only process stuff that can be
# read NOW.
my $return = ;
my @ready = $Select-can_read(0);
foreach my $socket (@ready) {
if ($socket == $SERVER) {
my $new = $socket-accept();
$Select-add($new);
} else {
my $buf = ;
my $char = getc($socket);
while ((defined($char)) ($char ne \n)) {
$buf .= $char;
$char = getc($socket);
}
$return = processRequest($buf);
$socket-send($return);
$Select-remove($socket);
close($socket);
}
}
}
---end perl--
socketinitialize is called during daemon startup, and checkconnections
is called in a loop
send: Cannot determine peer address at myscript.pl line 1256
You say that perl dies when it reads, but that message mentions
'send'. What are you really doing around line 1256?
line 1256 is in checkconnections: $socket-send($return);
(Why didn't you
include some of that relevant code in the first place?)
Sorry, I'm at work now, and typed that up in haste. :D
Did your perl binary pass all tests before installation?
Yup
Good luck tracking down this bug!
thanks!
--Tom Phoenix
Stonehenge Perl Training
--
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: unix date for perl time calculation
On 3/21/07, Kevin Viel [EMAIL PROTECTED] wrote: I want to determine the amount of time one of my scripts and figured collecting the beginning and ending date might suffice, if I could feed it to, say, perl for the calculation: d0=`date` d1=`date` perl -e $d1 - $d0 log Is this worth exploring? Could someone direct me to a useful reference (while I begin to RTFM). That should work, but if you're running on a *nix system, you could see if you have the time utilitiy. something like $ time myscript.pl will output how long it took as well as some other summary info after the program exits. Thank you, Kevin -- Kevin Viel Department of Genetics [EMAIL PROTECTED] Southwest Foundation for Biomedical Research phone: (210)258-9884 P.O. Box 760549 fax:(210)258-9444 San Antonio, TX 78245-0549 Kevin Viel PhD Candidate Department of Epidemiology Rollins School of Public Health Emory University Atlanta, GA 30322 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ -- -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
Re: confusion with splitting columns using [-n, -n] (e.g; my ( $country, $bytes ) = ( split )[ -2, -1 ])
On 1/30/07, Michael Alipio [EMAIL PROTECTED] wrote:
Hi,
I have a file that look like this:
1668 | 172.194.177.182 | US12679172
10396 | 64.237.148.157 | PR 12679172
9318 | 211.187.212.242 | KR1279172
22291 | 66.215.254.186 | US 1269172
22291 | 24.176.212.76 | US 1679172
30225 | 66.147.146.214 | US 2679172
17676 | 221.34.8.92 | JP 1267173
17858 | 125.180.111.187 | KR12679172
6395 | 67.96.150.40 | US 12679172
17858 | 125.180.193.124 | KR 12679175
3462 | 218.168.176.39 | TW12679472
9919 | 218.211.204.195 | TW12666172
9318 | 222.235.22.225 | KR 12672272
9318 | 222.237.14.160 | KR 12679142
Six columns including two colums with pipe symbols.
The goal is to add up the values in the last column that belongs to the same
country. That last column are the bytes received by a particular country. So I
have to add all bytes received by US, KR, etc.
Someone has given me this code:
open WHOISWITHBYTES, '', whois.bytes or die $!;
my %data;
while ( WHOISWITHBYTES ) {
my ( $country, $bytes ) = ( split )[ -2, -1 ];
$data{ $country } += $bytes;
}
print Country Total Bytes\n;
for my $country ( sort { $data{ $b } = $data{ $a } } keys %dat
a ) {
print $country $data{ $country }\n;
}
It is working perfectly but now, I need to document this code. Can anyone help
me out on understanding this code.
I'm particularly confused with the line:
my ($country, $bytes) = (split) [-2, -1];
What does this tells? What does -2 and -1 tells? All I know is that split will
output a list containing two values that will be assigned to $country and
$bytes for every line of that whois.bytes file. But I'm not sure what those
-2,-1 means and how it was able to extract column 5 and 6. I tried looking at
perldoc -f split but cannot seem to find the explanation. Are those the LIMIT
thing?
(split) gives you an array, and then you are referencing the last two
items. Negative array indecies mean to start that far from the end of
the list, similar to negative character offsets in substr.
Thanks!
Any questions? Get answers on any topic at www.Answers.yahoo.com. Try it now.
--
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Net::BitTorrent::File problems
Never mind. I got it straightened out. I just had to
...
my $pieces = $info-{'pieces'};
$pieces =~ s/(.)/sprintf(%02x,ord($1))/egs;
...
On 1/11/07, Andy Greenwood [EMAIL PROTECTED] wrote:
I'm trying to extract the SHA1 hashes out of a .torrent file using
Net::BitTorrent::File, among other information, but can't seem to
figure out how to get them. I keep getting binary data, not the ascii
hash. Can anyone tell me what I'm doing wrong here?
#!/usr/bin/perl
use strict;
use warnings;
use Convert::Bencode qw(bencode bdecode);
use Net::BitTorrent::File;
use Data::Dumper;
my $file = shift;
my $torrent = new Net::BitTorrent::File ($file);
$torrent or die(Couldn't load torrent file);
# name
print name : .$torrent-name().\n;
# get the info hash
my $info = $torrent-info();
# piece length
my $piece_len = $info-{'piece length'};
print piece length is : .$piece_len.\n;
# pieces ***
my $pieces = $info-{'pieces'};
my @pieces_array = ();
# Seperate into 20-byte pieces
while ($pieces ne ) {
my $piece = substr($pieces, 0, 20);
push(@pieces_array, $piece);
$pieces = substr($pieces, 20);
}
foreach (@pieces_array) {
print piece : .$_.\n;
}
--
I'm nerdy in the extreme and whiter than sour cream
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Net::BitTorrent::File problems
I'm trying to extract the SHA1 hashes out of a .torrent file using
Net::BitTorrent::File, among other information, but can't seem to
figure out how to get them. I keep getting binary data, not the ascii
hash. Can anyone tell me what I'm doing wrong here?
#!/usr/bin/perl
use strict;
use warnings;
use Convert::Bencode qw(bencode bdecode);
use Net::BitTorrent::File;
use Data::Dumper;
my $file = shift;
my $torrent = new Net::BitTorrent::File ($file);
$torrent or die(Couldn't load torrent file);
# name
print name : .$torrent-name().\n;
# get the info hash
my $info = $torrent-info();
# piece length
my $piece_len = $info-{'piece length'};
print piece length is : .$piece_len.\n;
# pieces ***
my $pieces = $info-{'pieces'};
my @pieces_array = ();
# Seperate into 20-byte pieces
while ($pieces ne ) {
my $piece = substr($pieces, 0, 20);
push(@pieces_array, $piece);
$pieces = substr($pieces, 20);
}
foreach (@pieces_array) {
print piece : .$_.\n;
}
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
Re: Hi,, Regarding perl modules
On 10 Jan 2007 09:21:55 -, Vikas Kumar Choudhary [EMAIL PROTECTED] wrote: Hi I am vikas here, just getting in perl.. can anybody told me to create modules and how to use these in our scripts.. $ perldoc perlmod should get you started. To use modules you've created, just put this at the top of your program. use yourMod; Thanks Vikas Kumar Choudhary Software Engineer Bangalore-50078 Mobile:- 91-9886793145 -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/
subroutine call makes foreach exit?
I'm writing a script for work that will dig for DNS records for a
given domain name and put the entries into an array. At the end of the
digging, it outputs the array elements to the screen, asks if
everything looks good, and if so, writes them out to the shell and
builds a zone file. However, I've come across a wierd problem
when I dig for MX records, they may or may not be in my list of
subdomains to dig for, so I call getAforMX(mx server) which should
track down the actual A record and push that into my dns_commands
array. However, when it comes back, it fails to do the same for the
remaining MX records
here's the script.
start
#!/usr/bin/perl
use warnings;
use strict;
my $domain = shift || die Usage: dns_replicate domain.name [name
server [name server [...]]];
my @servers = @ARGV || qw( ns1.myisp.net ns2.myisp.net );
my @tmp = ();
my @digOut = ();
my @dns_commands = ();
my @subdomains = qw( www citrix server mailserver webserver webmail
mail pop smtp ftp );
# Test to see if we already have a zone file
@tmp = `dns_lookup $domain`;
if ($tmp[0] =~ /MASTER/) {
print \n-ERR We appear to already have a zone file for this
domain. exiting\n;
shift @tmp;
shift @tmp;
foreach (@tmp) {
print;
}
print \n;
exit;
}
# Now we've got an array of good name servers to try and dig from
# begin building the command array
push @dns_commands, dns_create $domain noweb\n;
# get the MX records
@digOut = `dig [EMAIL PROTECTED] $domain MX`;
foreach (@digOut) {
if (/^$domain.+MX\s+(\d+)\s+(.+)/) {
my $pref;
if ($1 == 0) {
$pref = 1;
} else {
$pref = $1;
}
push @dns_commands, dns_mx_add $domain \@ $pref $2\n;
getAforMX($2);
}
}
# Next get the domain's @ record
@digOut = `dig [EMAIL PROTECTED] $domain A`;
foreach (@digOut) {
if (/^$domain.+\sA\s+(.+)/) {
push @dns_commands, dns_a_add $domain \@ $1\n;
}
}
# Next loop through the subdomains array
foreach my $sd (@subdomains) {
@digOut = `dig [EMAIL PROTECTED] $sd.$domain`;
foreach (@digOut) {
if (/^$sd\.$domain.+\sIN\s+(\w+)\s+(.+)/) {
my $rectype = lc($1);
push @dns_commands, dns_.$rectype._add
$domain $sd $2\n;
}
}
}
print These are the commands I'm about to run. If everything looks good,\n;
print Press enter. Otherwise, hit ctrl-c to quit.\n\n;
foreach (@dns_commands) {
print;
}
my $junk = STDIN;
foreach (@dns_commands) {
system($_);
}
sub getAforMX {
my $mx = shift || die Argument mis-match in getAforMX(): No
MX server!;
if ($mx !~ /$domain\./) {
# MX record points to another domain, no work to do
}
@digOut = `dig [EMAIL PROTECTED] $mx`;
foreach (@digOut) {
if (/^(.+)\.$domain\..+\sIN\s+(\w+)\s+(.+)/) {
my $rectype = lc($2);
push @dns_commands, dns_.$rectype._add
$domain $1 $3\n;
}
}
}
---end--
Here's some sample output that demonstrates my problem
If I comment out the call to getAforMX(), I get all three mx servers
[EMAIL PROTECTED] ~]$ ./digger microsoft.com
These are the commands I'm about to run. If everything looks good,
Press enter. Otherwise, hit ctrl-c to quit.
dns_create microsoft.com noweb
dns_mx_add microsoft.com @ 10 mailb.microsoft.com. ---gets all three MX records
dns_mx_add microsoft.com @ 10 mailc.microsoft.com.
dns_mx_add microsoft.com @ 10 maila.microsoft.com.
dns_a_add microsoft.com @ 207.46.130.108
dns_a_add microsoft.com @ 207.46.250.119
dns_cname_add microsoft.com www toggle.www.ms.akadns.net.
dns_a_add microsoft.com mail 131.107.1.71
dns_a_add microsoft.com smtp 131.107.115.212
dns_a_add microsoft.com smtp 131.107.115.214
dns_a_add microsoft.com smtp 131.107.115.215
dns_a_add microsoft.com smtp 205.248.106.30
dns_a_add microsoft.com smtp 205.248.106.32
dns_a_add microsoft.com smtp 205.248.106.64
dns_a_add microsoft.com ftp 207.46.236.102
If I do make the call to getAforMX(), it gets the A records for the
first server, then mysteriously exits the foreach loop which surrounds
the call to getAforMX().
[EMAIL PROTECTED] ~]$ ./digger microsoft.com
These are the commands I'm about to run. If everything looks good,
Press enter. Otherwise, hit ctrl-c to quit.
dns_create microsoft.com noweb
dns_mx_add microsoft.com @ 10 maila.microsoft.com. -no other MX
records listed ?
dns_a_add microsoft.com maila 205.248.106.64 ---but it
does get the A records
dns_a_add microsoft.com maila 131.107.115.212
dns_a_add microsoft.com @ 207.46.130.108
dns_a_add microsoft.com @ 207.46.250.119
dns_cname_add microsoft.com www toggle.www.ms.akadns.net.
dns_a_add microsoft.com mail 131.107.1.71
dns_a_add microsoft.com smtp
Re: subroutine call makes foreach exit?
On 11/16/06, Jay Savage [EMAIL PROTECTED] wrote: On 11/16/06, Andy Greenwood [EMAIL PROTECTED] wrote: I'm writing a script for work that will dig for DNS records for a given domain name and put the entries into an array. At the end of the digging, it outputs the array elements to the screen, asks if everything looks good, and if so, writes them out to the shell and builds a zone file. However, I've come across a wierd problem [snip] Not weird at all. Your problem is most likely right here: @digOut = `dig [EMAIL PROTECTED] $mx`; take a look at the foreach section of the perlsyn (perl syntax) man page. you should read the whole thing if you're having these kinds of trouble (actually, you should read it anyway), but the relevant bit for the moment is: If any part of LIST is an array, foreach will get very confused if you add or remove elements within the loop body, for example with splice. *So don't do that.* Or in this case, by replacing the entire array with new output from dig in the subroutine. Aha! thank you so much. using a different array var in the subroutine did indeed fix it. HTH, -- jay -- This email and attachment(s): [ ] blogable; [ x ] ask first; [ ] private and confidential daggerquill [at] gmail [dot] com http://www.tuaw.com http://www.downloadsquad.com http://www.engatiki.org values of β will give rise to dom! -- I'm nerdy in the extreme and whiter than sour cream
Re: Analize Java source file with perl?
I'm sure there's a better way to do this, but it really isn't too hard.
-start---
#!/usr/bin/perl
use warnings;
use strict;
my $file = shift || die Please provide a java file to check.\n;
my @lines = `cat $file`;
foreach (@lines) {
/class (\w+)/ print $1\n;
}
--- end -
On 10/26/06, bou, hou (GE Money, consultant) [EMAIL PROTECTED] wrote:
hello, all
I want to get the Class name of .java file with perl ,
How can I do it ? I think it is difficult to result the java comment .
For Example
a java file named AAA.java
/* author : John Smith */
// comment
public class ClassA {
/* */
//comment
public static void main(String[] args) {
}
...
}
class ClassB {
...
}
-
I want to get like this
perl ClassChecker.pl AAA.java
ClassA
ClassB
thank u.
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Bad scoping? Bad prototyping?
On 10/9/06, Helliwell, Kim [EMAIL PROTECTED] wrote:
The following test script fails to compile, complaining that there are
not enough arguments
in the call to sub2.
#!/bin/perl
sub1(Hello, );
sub1(world\n);
Are you sure you want sub1 prototyped twice?
sub sub2($str)
{
print $str;
}
sub sub1($str)
{
sub2($str)
}
The basic problem is that I'm trying to call one subroutine from inside
another. I'm sure I've had
this work before, but there's clearly something I'm doing wrong this
time.
Any clues?
Thanks,
Kim Helliwell
LSI Logic Corporation
Work: 408 433 8475
Cell: 408 832 5365
[EMAIL PROTECTED]
Please Note: My email address will change to [EMAIL PROTECTED]
mailto:[EMAIL PROTECTED] on Oct 14. The old 'lsil.com' email
address will stop working after Jan 15, 2007. Please update your address
book and distribution lists accordingly. Thank you.
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: Where to change @INC in perl
How did you install the module? you should be able to just # cd /usr/ports/databases/p5-DBI/ make install clean and it'll work like a charm. That's all I did. For modules that exist in the ports tree, I find that installing them this way is cleaner than perl -MCPAN -e install foo::bar because the freebsd package management tools will update everything for you. Note that if you have a different version of the module installed in /usr/local/lib/perl5/5.00503, they might conflict. I'd remove that and start over. On 04 Oct 2006 07:01:50 -0700, Randal L. Schwartz merlyn@stonehenge.com wrote: narmadha == narmadha palanisamy [EMAIL PROTECTED] writes: narmadha I am newbie to the perl. narmadha I have installed DBI perl module in FreeBSD under this directory narmadha /usr/local/lib/perl5/5.00503. Why did you do that when it wasn't one of the libraries that your Perl binary is looking for? Also, why 5.5.3, when you're obviously running 5.8.7? If you use the CPAN.pm module to install DBI, it will build it properly and install it into the site_perl directories for your machine. Do that instead. You *cannot* change the default @INC. If you want to run unmodified programs with locally installed modules, those modules *must* be installed in the listed directories. narmadha The information contained in this electronic message and any narmadha attachments to this message are intended for the exclusive use of narmadha the addressee(s) and may contain proprietary, confidential or narmadha privileged information. If you are not the intended recipient, you narmadha should not disseminate, distribute or copy this e-mail. Please narmadha notify the sender immediately and destroy all copies of this message narmadha and any attachments. Please either: (a) turn off this disclaimer or (b) subscribe from an address that doesn't do this These disclaimers are unenforcable, and just plain annoying. -- Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095 merlyn@stonehenge.com URL:http://www.stonehenge.com/merlyn/ Perl/Unix/security consulting, Technical writing, Comedy, etc. etc. See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training! -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
socket question
I'm having some trouble with my perl script which uses IO::Select and
IO::Socket to multiplex incoming connections as described here
http://www.perlfect.com/articles/select.shtml
Now, I am able to connect to the script using telnet, but when I try
to connect to it with my php script which will be used to connect to
the script in production, I get
send: Cannot determine peer address at
/usr/local/www/root/trunk/html/bin/fluxd/fluxd.pl line 603
Since I'm able to connect to it with telnet, I'm leaning towards a
problem with the way php is connecting to it, but I just wanted to
make sure that everything looks good here.
use strict;
use warnings;
my $Select = new IO::Select();
$SERVER = IO::Socket::UNIX-new(
Type= SOCK_STREAM,
Local = $PATH_SOCKET,
Listen = 16,
Reuse = 1,
);
$Select-add($SERVER);
#--#
# Sub: checkConnections#
# Arguments: null #
# Returns: null#
#--#
sub checkConnections {
# Get the readable handles. timeout is 0, only process stuff that can be
# read NOW.
my $return = ;
my @ready = $Select-can_read(0);
foreach my $socket (@ready) {
if ($socket == $SERVER) {
my $new = $socket-accept();
$Select-add($new);
} else {
my $buf = ;
my $char = getc($socket);
while ((defined($char)) ($char ne \n)) {
$buf .= $char;
$char = getc($socket);
}
if ($buf) {
$return = processRequest($buf);
$socket-send($return);
} else {
$Select-remove($socket);
close($socket);
}
}
}
}
--
I'm nerdy in the extreme and whiter than sour cream
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
Re: perl scalar
if you use strict; then you'll need to declare it with my. If you don't (and you should think about that decision again) then you can leave off the my. my $variable = somevalue; $ means it's a scalar variable @ is for arrays % is for hashes On 9/20/06, elite elite [EMAIL PROTECTED] wrote: how would i create a scalar? __ Do You Yahoo!? Tired of spam? Yahoo! Mail has the best spam protection around http://mail.yahoo.com -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response -- I'm nerdy in the extreme and whiter than sour cream -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
Re: Extract digits from string
start with the regex. It's going to look in $data for items that match and return the elements caught by the ()'s into @array. the regex will catch anything that: 1) starts with a ( 2) is made up of at least 1 digit character 3) ends with a ) On 9/8/06, J. Alejandro Noli [EMAIL PROTECTED] wrote: Jeff Pang [EMAIL PROTECTED] writes: Hi,how about this? my @array = $data =~ /\((\d+)\)/g; And what does this means ^^ ? Thanks ! -Original Message- From: john wright [EMAIL PROTECTED] Sent: Sep 5, 2006 11:29 AM To: beginners@perl.org -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] http://learn.perl.org/ http://learn.perl.org/first-response
accessing an array of hashes from another namespace
I have a program which I am working on which has several different
packages. One of these packages, FluxDB.pm, creates an array of hashes
called @users. Each element is a hash containing (among other things)
username and uid (primary key from the DB this is generated out of).
In another package, Qmgr.pm, I need to do several things with this
array. first I need to add a couple of new hash elements which are
arrays, and then I need to access those arrays for both read and write
access. So far I have something like this, but it isn't working. Can
anyone point me in the right direction?
in Qmgr.pm
foreach my $user (@FluxDB::users) {
# $user should be a regular hash here, correct?
$user{'foo'} = ();
$user{'bar'} = ();
}
Any help would be much appreciated!
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/ http://learn.perl.org/first-response
