onegative has asked for the wisdom of the Perl Monks concerning the following question:

Good day Monks,
I have a problem that is bewildering me and I am sure its due to my lack of knowledge. I have built a small LISTENER using IO::Socket in which I pass a string from the client which represents a GroupName. I appear to be doing what I want until the time I try and use the variable in my DBI function that will extract members of the Group and then recursively extract all sub-groups until only the non-groups exist and I pass them back from the function and want to return to the socket client which made the initial request. The getGrpMembers() works correctly when I use the snippet of code outside the socket code but not when embedded within...any help in trying to understand my BREAKDOWN would be greatly appreciated...
Thanks,
Danny
#!/opt/app/telalert/perl5.8.8/bin/perl use DBI; use IO::Socket; use IO::Select; require "SOCK_DBI.pl"; #require "getDate.func"; # Create a socket to listen on. # my $listener = IO::Socket::INET->new( LocalPort => 8888, Listen => 5, Reuse => 1 ); die "Can't create socket for listening: $!" unless $listener; print "Listening for connections on port 8888\n"; my $readable = IO::Select->new; # Create a new IO::Select object $readable->add($listener); # Add the listener to it while(1){ # Get a list of sockets that are ready to talk to us. # my ($ready) = IO::Select->select($readable, undef, undef, unde +f); foreach my $s (@$ready) { # Is it a new connection? # if($s == $listener) { # Accept the connection and add it to our readable lis +t. # my $new_sock = $listener->accept; $readable->add($new_sock) if $new_sock; print $new_sock "HELO\r\n"; } else { # It's an established connection my $buf = <$s>; # Try to read a line # Was there anyone on the other end? # if( defined $buf ){ # If they said goodbye, close the socket. If n +ot, # echo what they said to us. # if ($buf =~ /goodbye/i) { print $s "TelAlert Query Exit\n"; $readable->remove($s); $s->close; } else { chomp($buf); &declareGlobalVariables; # DBI->trace(1,'/tmp/dbi.log'); $dbh = &getOracleLogin("$ORACLE_SID", "$OR +ACLE_USERID", "$ORACLE_PASSWORD"); $dbh->{LongReadLen} = 64000; push(@groups, $buf); # Place received Grou +pName ($buf) into groups array to use for recursive database query $scale = scalar(@groups); # Scalarize grou +ps array for while statement below while( $scale > 0 ){ $grp = shift(@groups); # Extract Group +Name and Remove from groups array # BREAKDOWN IS HERE the $grp variable +is WEIRD when printed and will not feed correctly into next function. +.. @members = &getGrpMembers($grp); foreach $member (@members){ if( $member =~ /Destination/ ){ ($device, $trash) = split(/~/, + $member); push(@dest, $device); } if( $member =~ /User/ ){ ($user, $trash) = split(/~/, $ +member); push(@dest, $user); } if( $member =~ /Group/ ){ ($mem, $trash) = split(/~/, $m +ember); push(@groups, $mem); } } $scale = scalar(@groups); } print $s "@dest\n"; &logoffOracle($dbh); } } else { # The client disconnected. $readable->remove($s); $s->close; print STDERR "Client Connection closed\n"; } } } }

Replies are listed 'Best First'.
Re: IO::Socket and passed variables to functions
by chromatic (Archbishop) on Dec 16, 2008 at 23:47 UTC

    What does this mean?

    the $grp variable is WEIRD when printed and will not feed correctly into next function.

    What is a "weird" variable? What do you expect it to contain? What does it contain? Where's the code for getGrpMembers()?

Re: IO::Socket and passed variables to functions
by gone2015 (Deacon) on Dec 16, 2008 at 23:56 UTC

    In what way is the contents of $grp "weird" ?

    AFAICS, you collect what you receive from the client so: @push(@groups, $buf) and later $grp = shift(@groups)... so, unless what you receive is not what you expect it's hard to see what could be wrong. I note you did a chomp($buf) -- in a network environment, where CRLF is a common line ending, $buf =~ s/\s+$// will do a complete job (while chomp may not).

    I am also required to mention use strict and use warnings.

Re: IO::Socket and passed variables to functions
by ig (Vicar) on Dec 17, 2008 at 00:34 UTC

    I don't see what the problem is. This may be because it is in the code you haven't posted. But I have some suggestions and questions you might think about, that might help you narrow down where the problem is.

    It may help you to use strict and warnings, and use lexically scoped variables (my) where possible. It is a good habit to get into even if it doesn't help here.

    You could check your inputs from the socket and from your getGrpMembers() subroutine to ensure they contain only valid characters.

    Is the WEIRD instance of $grp a value read from the client or one returned from getGrpMembers() in a previous iteration of your loop?

    Does $buf, as read from the socket, have reasonable content?

    Do any of the values returned by getGrpMembers begin with WEIRD stuff, followed by '~' and with "Group" anywhere in the string?

      When I say weird, I mean I tried to print the variable .i.e.
      The value passed to the $grp was CIC
      print "START~" . $grp . "~END\n";
      which should have produced an output of START~CIC~END but it did not...it printed something like ENDsCIC
      As I stated earlier the block of code being used to query the database works if I just put it in a simple script and pass the value into say $grp = $ARGV[0];
      The only real difference I see between what I am doing in the LISTENER and the straight perl script is assigning initial groups array to begin

      push(@groups, $buf) versus @groups = $ARGV[0];


      Here is the rest of the code from the SOCK_DBI.pl<br/><br/> # +--------------+ # | SUB ROUTINES | # +--------------+ # SOCK_DBI.p # sub declareGlobalVariables { $ORACLE_SID = "D0TALRT1"; $ORACLE_USERID = "dunnyuser"; $ORACLE_PASSWORD = "applesauce"; $ENV{'ORACLE_SID'} = "$ORACLE_SID"; $ENV{'ORACLE_HOME'} = "/opt/app/talertdb/oracle/9.2.0"; } sub getOracleLogin { local ($oracle_sid, $username, $password) = @_; local ($temp_dbh); local($tempID, $tempPassword, $tempKey); local $conn = "dbi:Oracle:HOST=windsordb.wdc.gdc.net;SID=D0TALRT1;po +rt=1521"; # unless ( $temp_dbh = DBI->connect( "DBI:Oracle:$oracle_sid" unless ( $temp_dbh = DBI->connect( $conn , "$username" , $password , {AutoCommit => 0}) ) { &programError( "Oracle Login Failed as $username" , "" , "$DBI::errstr" , "dba-mail" , "dba-pager"); exit; } } sub programError { $logfile = "/opt/app/telalert/tmp/dbi_error"; open(ELOG, ">>$logfile") || die "Can't open filename: $logfile - $!\ +n"; local($message, $sql_statement, $ora_errstr) = @_; print ELOG "+--------------------------+\n"; print ELOG "| SUB: programError |\n"; print ELOG "+--------------------------+\n"; print ELOG "\n"; unless($message) {$message = "No message provided from calling modul +e.";} print ELOG "+------------------------------------------------------- ++\n"; print ELOG "| ******************* PROGRAM ERROR ******************* +|\n"; print ELOG "+------------------------------------------------------- ++\n"; print ELOG "\n"; print ELOG "\n"; print ELOG "Message:\n"; print ELOG "-------------------------------------------------------- +\n"; print ELOG "$message\n"; print ELOG "\n"; if ($sql_statement) { print ELOG "SQL:\n"; print ELOG "------------------------------------------------------ +--\n"; print ELOG "$sql_statement\n"; print ELOG "\n"; } if ($ora_errstr) { print ELOG "Oracle Error:\n"; print ELOG "------------------------------------------------------ +--\n"; print ELOG "$ora_errstr\n"; } close(ELOG); } sub logoffOracle { ($dbh) = @_; unless ($dbh->disconnect) { 1; } } sub getGrpMembers { my ($groupName) = @_; my @members = (); $sql_statement = "SELECT b.DISPLAY_NAME, b.MEMBER_TYPE FROM GR +OUPS a, MEMBERS b WHERE a.NAME=\'$groupName\' AND a.ID=b.GROUP_ID"; unless ($cursor = $dbh->prepare("$sql_statement")) { &programError( "Could not prepare SELECT_getGrpMembers_DBI c +ursor" , "$sql_statement" , "$DBI::errstr"); $dbh->rollback; &logoffOracle($dbh); exit; } unless ($cursor->execute) { &programError( "Could not execute SELECT_getGrpMembe +rs_DBI cursor" , "$sql_statement" , "$DBI::errstr"); $dbh->rollback; &logoffOracle($dbh); exit; } while (($display_name, $member_type) = $cursor->fetchrow_array +) { push(@members, "$display_name~$member_type"); } unless ($cursor->finish) { &programError( "Could not finish SELECT_getGrpMember +s_DBI cursor" , "$sql_statement" , "$DBI::errstr"); $dbh->rollback; &logoffOracle($dbh); exit; } return (@members); } 1;


      And if I take the same SOCK_DBI.pl and use the same functions in the next section of code it properly connects to the database and recursively extracts all the objects it is suppose to and therefore the ONLY difference I can determine is the fact that I am trying to use this function from within the IO::Socket object but for whatever reason it appears to be returning the value of the $grp variable in some weird way but I am not sure....

      This code works well using the the exact same SOCK_DBI.pl

      #!/opt/app/telalert/perl5.8.8/bin/perl use DBI; require "SOCK_DBI.pl"; &declareGlobalVariables; # DBI->trace(1,'/tmp/dbi.log'); $dbh = &getOracleLogin("$ORACLE_SID", "$ORACLE_USERID", "$ORACLE_PASSW +ORD"); $dbh->{LongReadLen} = 64000; @groups = $ARGV[0]; $scale = scalar(@groups); while( $scale > 0 ){ $grp = shift(@groups); @members = &getGrpMembers($grp); foreach $member (@members){ if( $member =~ /Destination/ ){($device, $trash) = split(/~/, +$member); push(@dest, $device);} if( $member =~ /User/ ){ ($user, $trash) = split(/~/, $member) +; push(@dest, $user);} if( $member =~ /Group/ ){($mem, $trash) = split(/~/, $member); + push(@groups, $mem);} } $scale = scalar(@groups); } $out = join("\n", @dest); print $out; &logoffOracle($dbh);

        A handy tool for checking weird output is the od command. If you pipe your output to od -c you will see all the non-printing characters. When I did this with your server (having added a print of what came in to $buf from the socket) I saw the following.

        0000000 L i s t e n i n g f o r c +o 0000020 n n e c t i o n s o n p o +r 0000040 t 8 8 8 8 \n b u f = " C +S 0000060 C \r " \n 0000064

        Applying the fix oshalla recommended solved the problem.

        The od command is usually installed on *nix systems and is available for Windows.

        I note also that you are interpolating whatever text you receive from the socket into your SQL statement without any validation. Consider what will happen if a nasty fragment of SQL was entered rather than a group name. You might lose data.

        A good habit is to always check your data from external sources to make sure it is valid. And you might use place holders in your SQL statement rather than interpolating the group name into the string to further reduce the risk.

        should have produced an output of START~CIC~END but it did not...it printed something like ENDsCIC

        Looks like the typical sign of a stray carriage return (\r), i.e. the print cursor is re-positioned to the beginning of the line, with initial text thus being overprinted by subsequent characters...  For example

        my $grp = "CIC\r"; print "START~" . $grp . "~END\n";

        would show the seemingly weird "~ENDT~CIC".

        Have you tried what oshalla suggested, i.e. $buf =~ s/\s+$// instead of chomp?  It should fix such CRLF issues.