Platon Technologies
not logged in Login Registration
EnglishSlovak
open source software development celebrating 10 years of open source development! Thursday, March 28, 2024

Diff for sendxmpp/sendxmpp between version 1.14 and 1.15

version 1.14, 2008/08/25 09:54:12 version 1.15, 2008/10/21 21:31:53
Line 4  eval 'exec /usr/bin/perl -w -S $0 ${1+"$
Line 4  eval 'exec /usr/bin/perl -w -S $0 ${1+"$
 if 0; # not running under some shell  if 0; # not running under some shell
   
 #  #
 # script to send message using xmpp (aka jabber),  # script to send message using xmpp (aka jabber),
 # somewhat resembling mail(1)  # somewhat resembling mail(1)
 #  #
 # Author:     Dirk-Jan C. Binnema <djcb AT djcbsoftware.nl>  # Author:     Dirk-Jan C. Binnema <djcb AT djcbsoftware.nl>
 # Maintainer: Lubomir Host 'rajo' <rajo AT platon.sk>  # Maintainer: Lubomir Host 'rajo' <rajo AT platon.sk>
 # Copyright (c) 2004 - 2005 Dirk-Jan C. Binnema  # Copyright (c) 2004 - 2005 Dirk-Jan C. Binnema
 # Copyright (c) 2006 - 2007 Lubomir Host 'rajo'  # Copyright (c) 2006 - 2009 Lubomir Host 'rajo'
 #  #
 # Homepage: http://sendxmpp.platon.sk  # Homepage: http://sendxmpp.platon.sk
 #  #
 # Released under the terms of the GNU General Public License v2  # Released under the terms of the GNU General Public License v2
 #  #
 # $Platon: sendxmpp/sendxmpp,v 1.13 2007-09-10 19:08:35 rajo Exp $  # $Platon: sendxmpp/sendxmpp,v 1.14 2008-08-25 09:54:12 rajo Exp $
 # $Id$  # $Id$
   
 use Authen::SASL qw(Perl); # authentication broken if Authen::SASL::Cyrus module installed  use Authen::SASL qw(Perl); # authentication broken if Authen::SASL::Cyrus module installed
Line 24  use Net::XMPP;
Line 24  use Net::XMPP;
 use Getopt::Long;  use Getopt::Long;
 use strict;  use strict;
   
 use open ':utf8';  use open ':utf8';
 use open ':std';  use open ':std';
   
 # subroutines decls  # subroutines decls
 sub xmpp_login($$$$$$$$);  sub xmpp_login($$$$$$$$);
Line 48  $VERSION    = [ q$Revision$ =~ m/(\S+)\s*$/
Line 48  $VERSION    = [ q$Revision$ =~ m/(\S+)\s*$/
 my $RESOURCE = 'sendxmpp';  my $RESOURCE = 'sendxmpp';
 my $VERBOSE  = 0;  my $VERBOSE  = 0;
 my $DEBUG    = 0;  my $DEBUG    = 0;
   my @suppported_message_types    = qw( message chat headline );
   my $message_type                                = 'message'; # default message type
   
 # start!  # start!
 &main;  &main;
   
Line 58  my $DEBUG    = 0;
Line 60  my $DEBUG    = 0;
 sub main () {  sub main () {
   
     my $cmdline = parse_cmdline();      my $cmdline = parse_cmdline();
   
     $| = 1; # no output buffering      $| = 1; # no output buffering
   
     $DEBUG   = 1 if ($$cmdline{'debug'});      $DEBUG   = 1 if ($$cmdline{'debug'});
     $VERBOSE = 1 if ($$cmdline{'verbose'});      $VERBOSE = 1 if ($$cmdline{'verbose'});
   
     my $config = read_config_file ($$cmdline{'file'})      my $config = read_config_file ($$cmdline{'file'})
         unless ($$cmdline{'jserver'} && $$cmdline{'username'} && $$cmdline{'password'});          unless ($$cmdline{'jserver'} && $$cmdline{'username'} && $$cmdline{'password'});
   
     # login to xmpp      # login to xmpp
     my $cnx =  xmpp_login ($$cmdline{'jserver'}  || $$config{'jserver'},      my $cnx =  xmpp_login ($$cmdline{'jserver'}  || $$config{'jserver'},
                            $$cmdline{'port'}     || $$config{'port'},                             $$cmdline{'port'}     || $$config{'port'},
Line 77  sub main () {
Line 79  sub main () {
                            $$cmdline{'tls'},                             $$cmdline{'tls'},
                            $$cmdline{'debug'})                             $$cmdline{'debug'})
       or error_exit("cannot login: $!");        or error_exit("cannot login: $!");
   
   
     # read message from STDIN or or from -m/--message parameter      # read message from STDIN or or from -m/--message parameter
     if (!$$cmdline{interactive}) {      if (!$$cmdline{interactive}) {
   
         # the non-interactive case          # the non-interactive case
         my $txt;          my $txt;
         my $message = $$cmdline{'message'};          my $message = $$cmdline{'message'};
         if ($message) {          if ($message) {
             open (MSG, "<$message")              open (MSG, "<$message")
               or error_exit ("cannot open message file '$message': $!");                or error_exit ("cannot open message file '$message': $!");
             while (<MSG>) {$txt.=$_};              while (<MSG>) { $txt .= $_ };
             close(MSG);              close(MSG);
         }  else  {  
             $txt.=$_ while (<STDIN>);  
         }          }
           else {
               $txt .= $_ while (<STDIN>);
           }
   
         xmpp_send ($cnx,$cmdline,$config,$txt);          xmpp_send ($cnx,$cmdline,$config,$txt);
   
     } else {      } else {
         # the interactive case, read stdin line by line          # the interactive case, read stdin line by line
   
         # deal with TERM          # deal with TERM
         $main::CNX = $cnx;          $main::CNX = $cnx;
         $SIG{INT}=\&terminate;          $SIG{INT}=\&terminate;
   
         # line by line...          # line by line...
Line 122  sub main () {
Line 125  sub main () {
 # output: hash with 'user', 'jserver' and 'password' keys  # output: hash with 'user', 'jserver' and 'password' keys
 #  #
 sub read_config_file ($) {  sub read_config_file ($) {
   
     # check permissions      # check permissions
     my $cfg_file = shift;      my $cfg_file = shift;
     error_exit ("cannot read $cfg_file: $!")      error_exit ("cannot read $cfg_file: $!")
         unless (-r $cfg_file);          unless (-r $cfg_file);
     my $owner  = (stat _ )[4];      my $owner  = (stat _ )[4];
     error_exit ("you must own $cfg_file")      error_exit ("you must own $cfg_file")
       unless ($owner == $>);        unless ($owner == $>);
     my $mode = (stat _ )[2] & 07777;      my $mode = (stat _ )[2] & 07777;
     error_exit ("$cfg_file must not be accessible by others")      error_exit ("$cfg_file must not be accessible by others")
       if ($mode & 0077);        if ($mode & 0077);
   
     open (CFG,"<$cfg_file")      open (CFG,"<$cfg_file")
       or error_exit("cannot open $cfg_file for reading: $!");        or error_exit("cannot open $cfg_file for reading: $!");
   
Line 152  sub read_config_file ($) {
Line 155  sub read_config_file ($) {
                 if (/([\.\w_#-]+)@([-\.\w:;]+)\s+(\S+)\s*(\S+)?$/) {                  if (/([\.\w_#-]+)@([-\.\w:;]+)\s+(\S+)\s*(\S+)?$/) {
                         %config = (                          %config = (
                                 'username'      => $1,                                  'username'      => $1,
                                 'jserver'       => $2,                                  'jserver'       => $2,
                                 'port'          => 0,                                  'port'          => 0,
                                 'password'      => $3,                                  'password'      => $3,
                                 'component'     => $4,                                  'component'     => $4,
Line 176  sub read_config_file ($) {
Line 179  sub read_config_file ($) {
                         $config{'username'}     .= "\@$1";                          $config{'username'}     .= "\@$1";
                 }                  }
         }          }
   
     close CFG;      close CFG;
   
     error_exit ("no correct config found in $cfg_file")      error_exit ("no correct config found in $cfg_file")
       unless (scalar(%config));        unless (scalar(%config));
   
     if ($DEBUG || $VERBOSE) {      if ($DEBUG || $VERBOSE) {
         while (my ($key,$val) = each %config) {          while (my ($key,$val) = each %config) {
             debug_print ("config: '$key' => '$val'");              debug_print ("config: '$key' => '$val'");
         }          }
     }      }
   
     return \%config;      return \%config;
 }  }
   
   
Line 198  sub read_config_file ($) {
Line 201  sub read_config_file ($) {
 # output: hash with commandline options  # output: hash with commandline options
 #  #
 sub parse_cmdline () {  sub parse_cmdline () {
   
     usage() unless (scalar(@ARGV));      usage() unless (scalar(@ARGV));
   
         my ($subject,$file,$resource,$jserver,$port,$username,$password,$component,          my ($subject,$file,$resource,$jserver,$port,$username,$password,$component,
         $message, $chatroom, $headline, $debug, $tls, $interactive, $help, $raw, $verbose);          $message, $chatroom, $headline, $debug, $tls, $interactive, $help, $raw, $verbose);
     my $res = GetOptions ('subject|s=s'    => \$subject,      my $res = GetOptions ('subject|s=s'    => \$subject,
Line 212  sub parse_cmdline () {
Line 215  sub parse_cmdline () {
                           'password|p=s'   => \$password,                            'password|p=s'   => \$password,
                           'message|m=s'    => \$message,                            'message|m=s'    => \$message,
                           'headline|l'     => \$headline,                            'headline|l'     => \$headline,
                             'message-type=s' => \$message_type,
                           'chatroom|c'     => \$chatroom,                            'chatroom|c'     => \$chatroom,
                           'tls|t'          => \$tls,                            'tls|t'          => \$tls,
                           'interactive|i'  => \$interactive,                            'interactive|i'  => \$interactive,
Line 219  sub parse_cmdline () {
Line 223  sub parse_cmdline () {
                           'debug|d'        => \$debug,                            'debug|d'        => \$debug,
                           'raw|w'          => \$raw,                            'raw|w'          => \$raw,
                           'verbose|v'      => \$verbose);                            'verbose|v'      => \$verbose);
     usage () if ($help);      usage () if ($help);
   
         my @rcpt = @ARGV;          my @rcpt = @ARGV;
   
         if (defined($raw) && scalar(@rcpt) > 0) {          if (defined($raw) && scalar(@rcpt) > 0) {
                 error_exit "You must give a recipient or --raw (but not both)";                  error_exit("You must give a recipient or --raw (but not both)");
         }          }
         if ($raw && $subject) {          if ($raw && $subject) {
                 error_exit("You cannot specify a subject in raw XML mode");                  error_exit("You cannot specify a subject in raw XML mode");
Line 234  sub parse_cmdline () {
Line 238  sub parse_cmdline () {
         }          }
   
         if ($message && $interactive) {          if ($message && $interactive) {
                 error_exit "Cannot have both -m (--message) and -i (--interactive)";                  error_exit("Cannot have both -m (--message) and -i (--interactive)");
         }          }
   
           if (scalar(grep { $message_type eq $_ } @suppported_message_types) == 0) {
                   error_exit("Unsupported message type '$message_type'");
           }
   
           if ($headline) {
                   # --headline withouth --message-type
                   if ($message_type eq 'message') {
                           $message_type = 'headline'
                   }
                   else {
                           error_exit("Options --headline and --message-type are mutually exclusive");
                   }
           }
   
         if ($jserver && $jserver =~ /(.*):(\d+)/) {          if ($jserver && $jserver =~ /(.*):(\d+)/) {
                 $jserver = $1;                  $jserver = $1;
Line 251  sub parse_cmdline () {
Line 269  sub parse_cmdline () {
                 'username'    => ($username or ''),                  'username'    => ($username or ''),
                 'password'    => ($password or ''),                  'password'    => ($password or ''),
                 'chatroom'    => ($chatroom or 0),                  'chatroom'    => ($chatroom or 0),
                 'headline'    => ($headline or 0),                  'message-type'    => $message_type,
                 'interactive' => ($interactive or 0),                  'interactive' => ($interactive or 0),
                 'tls'         => ($tls or 0),                  'tls'         => ($tls or 0),
                 'debug'       => ($debug or 0),                  'debug'       => ($debug or 0),
Line 264  sub parse_cmdline () {
Line 282  sub parse_cmdline () {
        while (my ($key,$val) = each %dict) {         while (my ($key,$val) = each %dict) {
            debug_print ("cmdline: '$key' => '$val'");             debug_print ("cmdline: '$key' => '$val'");
        }         }
    }     }
   
    return \%dict;     return \%dict;
 }  }
   
   
Line 280  sub xmpp_login ($$$$$$$$) {
Line 298  sub xmpp_login ($$$$$$$$) {
     my ($host, $port, $user, $pw, $comp, $res, $tls, $debug) = @_;      my ($host, $port, $user, $pw, $comp, $res, $tls, $debug) = @_;
     my $cnx = new Net::XMPP::Client(debuglevel=>($debug?2:0));      my $cnx = new Net::XMPP::Client(debuglevel=>($debug?2:0));
     error_exit "could not create XMPP client object: $!"      error_exit "could not create XMPP client object: $!"
         unless ($cnx);          unless ($cnx);
   
     my @res;      my @res;
         my $arghash = {          my $arghash = {
Line 310  sub xmpp_login ($$$$$$$$) {
Line 328  sub xmpp_login ($$$$$$$$) {
                           'password' => $pw,                            'password' => $pw,
                           'resource' => $res);                            'resource' => $res);
     xmpp_check_result('AuthSend',\@res,$cnx);      xmpp_check_result('AuthSend',\@res,$cnx);
   
     return $cnx;      return $cnx;
 }  }
   
   
Line 322  sub xmpp_login ($$$$$$$$) {
Line 340  sub xmpp_login ($$$$$$$$) {
 # whether it's to individual or chatroom  # whether it's to individual or chatroom
 #  #
 sub xmpp_send ($$$$) {  sub xmpp_send ($$$$) {
   
         my ($cnx, $cmdline, $config, $txt) = @_;          my ($cnx, $cmdline, $config, $txt) = @_;
   
         unless ($$cmdline{'chatroom'}) {          unless ($$cmdline{'chatroom'}) {
         unless ($$cmdline{'raw'}) {          unless ($$cmdline{'raw'}) {
                         map {                          map {
Line 332  sub xmpp_send ($$$$) {
Line 350  sub xmpp_send ($$$$) {
                                         $_, #$$cmdline{'recipient'},                                          $_, #$$cmdline{'recipient'},
                                         $$cmdline{'component'} || $$config{'component'},                                          $$cmdline{'component'} || $$config{'component'},
                                         $$cmdline{'subject'},                                          $$cmdline{'subject'},
                                         $$cmdline{'headline'},                                          $$cmdline{'message-type'},
                                         $txt)                                          $txt)
                         } @{$$cmdline{'recipient'}};                          } @{$$cmdline{'recipient'}};
         }          }
Line 358  sub xmpp_send ($$$$) {
Line 376  sub xmpp_send ($$$$) {
 # input: connection,packet  # input: connection,packet
 #  #
 sub xmpp_send_raw_xml ($$) {  sub xmpp_send_raw_xml ($$) {
   
     my ($cnx,$packet) = @_;      my ($cnx,$packet) = @_;
   
     # for some reason, Send does not return anything      # for some reason, Send does not return anything
     $cnx->Send($packet);      $cnx->Send($packet);
     xmpp_check_result('Send',0,$cnx);      xmpp_check_result('Send',0,$cnx);
Line 372  sub xmpp_send_raw_xml ($$) {
Line 390  sub xmpp_send_raw_xml ($$) {
 # input: connection,recipient,subject,msg  # input: connection,recipient,subject,msg
 #  #
 sub xmpp_send_message ($$$$$$) {  sub xmpp_send_message ($$$$$$) {
   
     my ($cnx,$rcpt,$comp,$subject,$headline,$msg) = @_;  
   
         my $type = 'message';      my ($cnx, $rcpt, $comp, $subject, $message_type, $msg) = @_;
         if ($headline) {  
                 $type='headline';  
         }  
   
     # for some reason, MessageSend does not return anything      # for some reason, MessageSend does not return anything
     $cnx->MessageSend('to'      => $rcpt . ( $comp ? "\@$comp" : '' ),      $cnx->MessageSend('to'      => $rcpt . ( $comp ? "\@$comp" : '' ),
                 'type'          => $type,                  'type'          => $message_type,
                 'subject'       => $subject,                  'subject'       => $subject,
                 'body'          => $msg);                  'body'          => $msg);
   
     xmpp_check_result('MessageSend',0,$cnx);      xmpp_check_result('MessageSend',0,$cnx);
 }  }
   
   
 #  #
 # xmpp_send_chatroom_message: send a message to a chatroom  # xmpp_send_chatroom_message: send a message to a chatroom
 # input: connection,resource,subject,recipient,message  # input: connection,resource,subject,recipient,message
Line 397  sub xmpp_send_message ($$$$$$) {
Line 410  sub xmpp_send_message ($$$$$$) {
 sub xmpp_send_chatroom_message ($$$$$) {  sub xmpp_send_chatroom_message ($$$$$) {
   
     my ($cnx,$resource,$subject,$rcpt,$msg) =  @_;      my ($cnx,$resource,$subject,$rcpt,$msg) =  @_;
   
     # set the presence      # set the presence
     my $pres = new Net::XMPP::Presence;      my $pres = new Net::XMPP::Presence;
     my $res = $pres->SetTo("$rcpt/$resource");      my $res = $pres->SetTo("$rcpt/$resource");
   
     $cnx->Send($pres);      $cnx->Send($pres);
   
     # create/send the message      # create/send the message
     my $groupmsg = new Net::XMPP::Message;      my $groupmsg = new Net::XMPP::Message;
     $groupmsg->SetMessage(to      => $rcpt,      $groupmsg->SetMessage(to      => $rcpt,
                           body    => $msg,                            body    => $msg,
                           type    => 'groupchat');                            type    => 'groupchat');
   
     $res = $cnx->Send($groupmsg);      $res = $cnx->Send($groupmsg);
     xmpp_check_result ('Send',$res,$cnx);      xmpp_check_result ('Send',$res,$cnx);
   
     # leave the group      # leave the group
     $pres->SetPresence (Type=>'unavailable',To=>$rcpt);      $pres->SetPresence (Type=>'unavailable',To=>$rcpt);
 }  }
Line 423  sub xmpp_send_chatroom_message ($$$$$) {
Line 436  sub xmpp_send_chatroom_message ($$$$$) {
 # input: connection  # input: connection
 #  #
 sub xmpp_logout($) {  sub xmpp_logout($) {
   
     # HACK      # HACK
     # messages may not be received if we log out too quickly...      # messages may not be received if we log out too quickly...
     sleep 1;      sleep 1;
   
     my $cnx = shift;      my $cnx = shift;
     $cnx->Disconnect();      $cnx->Disconnect();
     xmpp_check_result ('Disconnect',0); # well, nothing to check, really      xmpp_check_result ('Disconnect',0); # well, nothing to check, really
Line 437  sub xmpp_logout($) {
Line 450  sub xmpp_logout($) {
   
 #  #
 # xmpp_check_result: check the return value from some xmpp function execution  # xmpp_check_result: check the return value from some xmpp function execution
 # input: text, result, [connection]  # input: text, result, [connection]
 #  #
 sub xmpp_check_result  sub xmpp_check_result
 {  {
     my ($txt, $res, $cnx)=@_;      my ($txt, $res, $cnx)=@_;
   
     error_exit ("Error '$txt': result undefined")      error_exit ("Error '$txt': result undefined")
         unless (defined $res);          unless (defined $res);
   
     # res may be 0      # res may be 0
         if ($res == 0) {          if ($res == 0) {
                 debug_print "$txt";                  debug_print "$txt";
                 # result can be true or 'ok'                  # result can be true or 'ok'
         }          }
         elsif ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') {          elsif ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') {
                 debug_print "$txt: " .  $$res[0];                  debug_print "$txt: " .  $$res[0];
                 # otherwise, there is some error                  # otherwise, there is some error
         }          }
         else {          else {
                 my $errmsg = $cnx->GetErrorCode() || '?';                  my $errmsg = $cnx->GetErrorCode() || '?';
                 error_exit ("Error '$txt': " . join (': ',@$res) . "[$errmsg]", $cnx);                  error_exit ("Error '$txt': " . join (': ',@$res) . "[$errmsg]", $cnx);
         }          }
Line 484  sub debug_print {
Line 497  sub debug_print {
   
 #  #
 # error_exit: print error message and exit the program  # error_exit: print error message and exit the program
 #             logs out if there is a connection  #             logs out if there is a connection
 # input: error, [connection]  # input: error, [connection]
 #  #
 sub error_exit {  sub error_exit {
   
     my ($err,$cnx) = @_;      my ($err,$cnx) = @_;
     print STDERR "$err\n";      print STDERR "$err\n";
     xmpp_logout ($cnx)      xmpp_logout ($cnx)
         if ($cnx);          if ($cnx);
   
     exit 1;      exit 1;
 }  }
   
Line 502  sub error_exit {
Line 515  sub error_exit {
 # usage: print short usage message and exit  # usage: print short usage message and exit
 #  #
 sub usage () {  sub usage () {
   
     print STDERR      print STDERR
         "sendxmpp version $VERSION\n" .          "sendxmpp version $VERSION\n" .
         "Copyright (c) 2004 - 2005 Dirk-Jan C. Binnema\n" .          "Copyright (c) 2004 - 2005 Dirk-Jan C. Binnema\n" .
         "Copyright (c) 2006 - 2007 Lubomir Host 'rajo'\n" .          "Copyright (c) 2006 - 2007 Lubomir Host 'rajo'\n" .
         "usage: sendxmpp [options] <recipient1> [<recipient2> ...]\n" .          "usage: sendxmpp [options] <recipient1> [<recipient2> ...]\n" .
         "or refer to the the sendxmpp manpage\n";          "or refer to the the sendxmpp manpage\n";
   
     exit 0;      exit 0;
 }  }
   
Line 518  sub usage () {
Line 531  sub usage () {
 # the fine manual  # the fine manual
 #  #
 =pod  =pod
   
 =head1 NAME  =head1 NAME
   
 sendxmpp - send xmpp messages from the commandline.  sendxmpp - send xmpp messages from the commandline.
Line 567  Connect securely, using TLS
Line 581  Connect securely, using TLS
   
 =item B<-l>,B<--headline>  =item B<-l>,B<--headline>
   
 Send a headline type message (not stored in offline messages)  Backward compatibility option. You should use B<--message-type=headline> instead. Send a headline type message (not stored in offline messages)
   
   =item B<--messages-type>
   
   Set type of message. Supported types are: B<message chat headline>. Default message type is B<message>. Headline type message can be set also with B<--headline> option, see B<--headline>
   
 =item B<-c>,B<--chatroom>  =item B<-c>,B<--chatroom>
   
 Send the message to a chatroom  Send the message to a chatroom
   
 =item B<-s>,B<--subject> I<subject>  =item B<-s>,B<--subject> I<subject>
   
Line 605  Show debugging info while running. B<WAR
Line 623  Show debugging info while running. B<WAR
   
 =head1 CONFIGURATION FILE  =head1 CONFIGURATION FILE
   
 You may define a 'F<~/.sendxmpprc>' file with the necessary data for your  You may define a 'F<~/.sendxmpprc>' file with the necessary data for your
 xmpp-account, with a line of the format:  xmpp-account, with a line of the format:
   
 =over  =over
Line 643  file is owned by you and readable only t
Line 661  file is owned by you and readable only t
   
      or to send to a chatroom:       or to send to a chatroom:
   
    $ echo "Dinner Time" | sendxmpp -r TheCook --chatroom test2@conference.jabber.org     $ echo "Dinner Time" | sendxmpp -r TheCook --chatroom test2@conference.jabber.org
   
      or to send your system logs somewhere, as new lines appear:       or to send your system logs somewhere, as new lines appear:
   
    $ tail -f /var/log/syslog | sendxmpp -i sysadmin@myjabberserver.com     $ tail -f /var/log/syslog | sendxmpp -i sysadmin@myjabberserver.com
   
      NOTE: be careful not the overload public jabber services       NOTE: be careful not the overload public jabber services
   
 =head1 SEE ALSO  =head1 SEE ALSO
   
 Documentation for the L<Net::XMPP> module  Documentation for the L<Net::XMPP> module

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS
Go to Top