Changeset b405ff6 for perl/modules


Ignore:
Timestamp:
Nov 10, 2006, 12:57:08 PM (18 years ago)
Author:
Nelson Elhage <nelhage@mit.edu>
Branches:
master, barnowl_perlaim, debian, release-1.10, release-1.4, release-1.5, release-1.6, release-1.7, release-1.8, release-1.9
Children:
d9f4a5c
Parents:
9f183ff
git-author:
Nelson Elhage <nelhage@mit.edu> (11/10/06 12:56:50)
git-committer:
Nelson Elhage <nelhage@mit.edu> (11/10/06 12:57:08)
Message:
perltidying jabber.pl and adding an emacs modeline
File:
1 edited

Legend:

Unmodified
Added
Removed

  • perl/modules/jabber.pl

    r9f183ff rb405ff6  
     1# -*- mode: cperl; cperl-indent-level: 4; indent-tabs-mode: nil -*-
    12package owl_jabber;
    23use warnings;
    … …  
    2627our %vars;
    2728
    28 sub onStart
    29 {
    30     if(eval{\&owl::queue_message})
    31     {
    32         register_owl_commands();
    33         push @::onMainLoop, sub { owl_jabber::onMainLoop(@_) };
    34         push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) };
    35     }
    36     else
    37     {
     29sub onStart {
     30    if ( eval { \&owl::queue_message } ) {
     31        register_owl_commands();
     32        push @::onMainLoop,     sub { owl_jabber::onMainLoop(@_) };
     33        push @::onGetBuddyList, sub { owl_jabber::onGetBuddyList(@_) };
     34    }
     35    else {
     36
    3837        # Our owl doesn't support queue_message. Unfortunately, this
    3938        # means it probably *also* doesn't support owl::error. So just
    … …  
    4443push @::onStartSubs, sub { owl_jabber::onStart(@_) };
    4544
    46 sub onMainLoop
    47 {
    48     return if (!connected());
    49    
    50     foreach my $jid (keys %$connections)
    51     {
    52         my $client = \$connections->{$jid}->{client};
    53 
    54         my $status = $$client->Process(0);
    55         if(!defined($status)) {
     45sub onMainLoop {
     46    return if ( !connected() );
     47
     48    foreach my $jid ( keys %$connections ) {
     49        my $client = \$connections->{$jid}->{client};
     50
     51        my $status = $$client->Process(0);
     52        if ( !defined($status) ) {
    5653            owl::error("Jabber account $jid disconnected!");
    5754            do_logout($jid);
    5855        }
    59         if ($::shutdown)
    60         {
    61             do_logout($jid);
    62             return;
    63         }
    64     }
    65 }
    66 
    67 sub blist_listBuddy
    68 {
     56        if ($::shutdown) {
     57            do_logout($jid);
     58            return;
     59        }
     60    }
     61}
     62
     63sub blist_listBuddy {
    6964    my $roster = shift;
    70     my $buddy = shift;
     65    my $buddy  = shift;
    7166    my $blistStr .= "    ";
    72     my %jq = $$roster->query($buddy);
     67    my %jq  = $$roster->query($buddy);
    7368    my $res = $$roster->resource($buddy);
    7469
    7570    $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID();
    76    
    77     if ($res)
    78     {
    79         my %rq = $$roster->resourceQuery($buddy, $res);
    80         $blistStr .= " [".($rq{show} ? $rq{show} : 'online')."]";
    81         $blistStr .= " ".$rq{status} if $rq{status};
    82         $blistStr = boldify($blistStr);
    83     }
    84     else
    85     {
    86         $blistStr .= $jq{ask} ? " [pending]" : " [offline]";
    87     }
    88 
    89     return $blistStr."\n";
    90 }
    91 
    92 sub onGetBuddyList
    93 {
     71
     72    if ($res) {
     73        my %rq = $$roster->resourceQuery( $buddy, $res );
     74        $blistStr .= " [" . ( $rq{show} ? $rq{show} : 'online' ) . "]";
     75        $blistStr .= " " . $rq{status} if $rq{status};
     76        $blistStr = boldify($blistStr);
     77    }
     78    else {
     79        $blistStr .= $jq{ask} ? " [pending]" : " [offline]";
     80    }
     81
     82    return $blistStr . "\n";
     83}
     84
     85sub onGetBuddyList {
    9486    my $blist = "";
    95     foreach my $jid (keys %{$connections})
    96     {
    97         my $roster = \$connections->{$jid}->{roster};
    98         if ($$roster)
    99         {
    100             $blist .= "\n".boldify("Jabber Roster for $jid\n");
    101            
    102             foreach my $group ($$roster->groups())
    103             {
    104                 $blist .= "  Group: $group\n";
    105                 foreach my $buddy ($$roster->jids('group',$group))
    106                 {
    107                     $blist .= blist_listBuddy($roster, $buddy);
    108                 }
    109             }
    110            
    111             my @unsorted = $$roster->jids('nogroup');
    112             if (@unsorted)
    113             {
    114                 $blist .= "  [unsorted]\n";
    115                 foreach my $buddy (@unsorted)
    116                 {
    117                     $blist .= blist_listBuddy($roster, $buddy);
    118                 }
    119             }
    120         }
     87    foreach my $jid ( keys %{$connections} ) {
     88        my $roster = \$connections->{$jid}->{roster};
     89        if ($$roster) {
     90            $blist .= "\n" . boldify("Jabber Roster for $jid\n");
     91
     92            foreach my $group ( $$roster->groups() ) {
     93                $blist .= "  Group: $group\n";
     94                foreach my $buddy ( $$roster->jids( 'group', $group ) ) {
     95                    $blist .= blist_listBuddy( $roster, $buddy );
     96                }
     97            }
     98
     99            my @unsorted = $$roster->jids('nogroup');
     100            if (@unsorted) {
     101                $blist .= "  [unsorted]\n";
     102                foreach my $buddy (@unsorted) {
     103                    $blist .= blist_listBuddy( $roster, $buddy );
     104                }
     105            }
     106        }
    121107    }
    122108    return $blist;
    … …  
    125111################################################################################
    126112### Owl Commands
    127 sub register_owl_commands()
    128 {
     113sub register_owl_commands() {
    129114    owl::new_command(
    130115        jabberlogin => \&cmd_login,
    … …  
    138123        jwrite => \&cmd_jwrite,
    139124        {
    140             summary     => "Send a Jabber Message",
    141             usage       => "jwrite JID [-g] [-t thread] [-s subject]"
     125            summary => "Send a Jabber Message",
     126            usage   => "jwrite JID [-g] [-t thread] [-s subject]"
    142127        }
    143128    );
    … …  
    145130        jlist => \&cmd_jlist,
    146131        {
    147             summary     => "Show your Jabber roster.",
    148             usage       => "jlist"
     132            summary => "Show your Jabber roster.",
     133            usage   => "jlist"
    149134        }
    150135    );
    … …  
    153138        {
    154139            summary     => "Jabber MUC related commands.",
    155             description => "jmuc sends jabber commands related to muc.\n\n".
    156                 "The following commands are available\n\n".
    157                 "join {muc}  Join a muc.\n\n".
    158                 "part [muc]  Part a muc.".
    159                 "            The muc is taken from the current message if not supplied.\n\n".
    160                 "invite {jid} [muc]\n\n".
    161                 "            Invite {jid} to [muc].\n".
    162                 "            The muc is taken from the current message if not supplied.\n\n",
    163             usage       => "jmuc {command} {args}"
    164         }
    165     );
    166 }
    167 
    168 sub cmd_login
    169 {
     140            description => "jmuc sends jabber commands related to muc.\n\n"
     141              . "The following commands are available\n\n"
     142              . "join {muc}  Join a muc.\n\n"
     143              . "part [muc]  Part a muc.\n"
     144              . "            The muc is taken from the current message if not supplied.\n\n"
     145              . "invite {jid} [muc]\n"
     146              . "            Invite {jid} to [muc].\n"
     147              . "            The muc is taken from the current message if not supplied.\n\n"
     148              . "configure [muc]\n" "            Configure [muc].\n"
     149              . "            Necessary to initalize a new MUC",
     150            usage => "jmuc {command} {args}"
     151        }
     152    );
     153}
     154
     155sub cmd_login {
    170156    my $cmd = shift;
    171157    my $jid = new Net::XMPP::JID;
    172158    $jid->SetJID(shift);
    173    
    174     my $uid = $jid->GetUserID();
     159
     160    my $uid           = $jid->GetUserID();
    175161    my $componentname = $jid->GetServer();
    176     my $resource = $jid->GetResource() || 'owl';
     162    my $resource      = $jid->GetResource() || 'owl';
    177163    $jid->SetResource($resource);
    178164    my $jidStr = $jid->GetJID('full');
    179165
    180     if (!$uid || !$componentname)
    181     {
    182         owl::error("usage: $cmd {jid}");
    183         return;
    184     }
    185 
    186     if ($connections->{$jidStr})
    187     {
    188         owl::error("Already logged in as $jidStr.");
    189         return;
    190     }
    191 
    192     my ($server, $port) = getServerFromJID($jid);
    193 
    194     $connections->{$jidStr}->{client} = Net::Jabber::Client->new(debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,
    195                                                                  debugfile  => 'jabber.log');
     166    if ( !$uid || !$componentname ) {
     167        owl::error("usage: $cmd {jid}");
     168        return;
     169    }
     170
     171    if ( $connections->{$jidStr} ) {
     172        owl::error("Already logged in as $jidStr.");
     173        return;
     174    }
     175
     176    my ( $server, $port ) = getServerFromJID($jid);
     177
     178    $connections->{$jidStr}->{client} = Net::Jabber::Client->new(
     179        debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,
     180        debugfile => 'jabber.log'
     181    );
    196182    my $client = \$connections->{$jidStr}->{client};
    197     $connections->{$jidStr}->{roster} = $connections->{$jidStr}->{client}->Roster();
     183    $connections->{$jidStr}->{roster} =
     184      $connections->{$jidStr}->{client}->Roster();
    198185
    199186    #XXX Todo: Add more callbacks.
    200187    # MUC presence handlers
    201     $$client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) },
    202                                   error => sub { owl_jabber::process_incoming_error_message(@_) },
    203                                   groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
    204                                   headline => sub { owl_jabber::process_incoming_headline_message(@_) },
    205                                   normal => sub { owl_jabber::process_incoming_normal_message(@_) });
    206 
    207     $vars{jlogin_connhash} = {hostname => $server,
    208                           tls => 1,
    209                           port => $port,
    210                           componentname => $componentname};
    211 
    212     my $status = $$client->Connect(%{$vars{jlogin_connhash}});
    213 
    214     if (!$status)
    215     {
    216         delete $connections->{$jidStr};
    217         delete $vars{jlogin_connhash};
    218         owl::error("We failed to connect");
    219         return "";
    220     }
    221 
    222 
    223     $vars{jlogin_authhash} = {username => $uid, resource => $resource, password => ''};
    224     my @result = $$client->AuthSend(%{$vars{jlogin_authhash}});
    225     if($result[0] ne 'ok')
    226     {
    227         if ($result[1] == 401)
    228         {
    229             $vars{jlogin_jid} = $jidStr;
    230             delete $connections->{$jidStr};
    231             owl::start_password("Password for $jidStr: ", \&do_login_with_pw);
    232             return "";
    233         }
    234         owl::error("Error in connect: " . join(" ", $result[1..$#result]));
    235         do_logout($jidStr);
    236         delete $vars{jlogin_connhash};
    237         delete $vars{jlogin_authhash};
     188    $$client->SetMessageCallBacks(
     189        chat      => sub { owl_jabber::process_incoming_chat_message(@_) },
     190        error     => sub { owl_jabber::process_incoming_error_message(@_) },
     191        groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
     192        headline  => sub { owl_jabber::process_incoming_headline_message(@_) },
     193        normal    => sub { owl_jabber::process_incoming_normal_message(@_) }
     194    );
     195
     196    $vars{jlogin_connhash} = {
     197        hostname      => $server,
     198        tls           => 1,
     199        port          => $port,
     200        componentname => $componentname
     201    };
     202
     203    my $status = $$client->Connect( %{ $vars{jlogin_connhash} } );
     204
     205    if ( !$status ) {
     206        delete $connections->{$jidStr};
     207        delete $vars{jlogin_connhash};
     208        owl::error("We failed to connect");
    238209        return "";
    239210    }
     211
     212    $vars{jlogin_authhash} =
     213      { username => $uid, resource => $resource, password => '' };
     214    my @result = $$client->AuthSend( %{ $vars{jlogin_authhash} } );
     215    if ( $result[0] ne 'ok' ) {
     216        if ( $result[1] == 401 ) {
     217            $vars{jlogin_jid} = $jidStr;
     218            delete $connections->{$jidStr};
     219            owl::start_password( "Password for $jidStr: ", \&do_login_with_pw );
     220            return "";
     221        }
     222        owl::error(
     223            "Error in connect: " . join( " ", $result[ 1 .. $#result ] ) );
     224        do_logout($jidStr);
     225        delete $vars{jlogin_connhash};
     226        delete $vars{jlogin_authhash};
     227        return "";
     228    }
    240229    $connections->{$jidStr}->{roster}->fetch();
    241     $$client->PresenceSend(priority => 1);
     230    $$client->PresenceSend( priority => 1 );
    242231    queue_admin_msg("Connected to jabber as $jidStr");
    243232    delete $vars{jlogin_connhash};
    … …  
    246235}
    247236
    248 sub do_login_with_pw
    249 {
     237sub do_login_with_pw {
    250238    $vars{jlogin_authhash}->{password} = shift;
    251239    my $jidStr = delete $vars{jlogin_jid};
    252     if (!$jidStr)
    253     {
    254         owl::error("Got password but have no jid!");
     240    if ( !$jidStr ) {
     241        owl::error("Got password but have no jid!");
    255242    }
    256243
    257244    $connections->{$jidStr}->{client} = Net::Jabber::Client->new();
    258245    my $client = \$connections->{$jidStr}->{client};
    259     $connections->{$jidStr}->{roster} = $connections->{$jidStr}->{client}->Roster();
    260 
    261     $$client->SetMessageCallBacks(chat => sub { owl_jabber::process_incoming_chat_message(@_) },
    262                                   error => sub { owl_jabber::process_incoming_error_message(@_) },
    263                                   groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
    264                                   headline => sub { owl_jabber::process_incoming_headline_message(@_) },
    265                                   normal => sub { owl_jabber::process_incoming_normal_message(@_) });
    266 
    267     my $status = $$client->Connect(%{$vars{jlogin_connhash}});
    268     if (!$status)
    269     {
    270         delete $connections->{$jidStr};
    271         delete $vars{jlogin_connhash};
    272         delete $vars{jlogin_authhash};
    273         owl::error("We failed to connect");
    274         return "";
    275     }
    276 
    277     my @result = $$client->AuthSend(%{$vars{jlogin_authhash}});
    278 
    279     if($result[0] ne 'ok')
    280     {
    281         owl::error("Error in connect: " . join(" ", $result[1..$#result]));
    282         do_logout($jidStr);
    283         delete $vars{jlogin_connhash};
    284         delete $vars{jlogin_authhash};
     246    $connections->{$jidStr}->{roster} =
     247      $connections->{$jidStr}->{client}->Roster();
     248
     249    $$client->SetMessageCallBacks(
     250        chat      => sub { owl_jabber::process_incoming_chat_message(@_) },
     251        error     => sub { owl_jabber::process_incoming_error_message(@_) },
     252        groupchat => sub { owl_jabber::process_incoming_groupchat_message(@_) },
     253        headline  => sub { owl_jabber::process_incoming_headline_message(@_) },
     254        normal    => sub { owl_jabber::process_incoming_normal_message(@_) }
     255    );
     256
     257    my $status = $$client->Connect( %{ $vars{jlogin_connhash} } );
     258    if ( !$status ) {
     259        delete $connections->{$jidStr};
     260        delete $vars{jlogin_connhash};
     261        delete $vars{jlogin_authhash};
     262        owl::error("We failed to connect");
    285263        return "";
    286264    }
    287265
     266    my @result = $$client->AuthSend( %{ $vars{jlogin_authhash} } );
     267
     268    if ( $result[0] ne 'ok' ) {
     269        owl::error(
     270            "Error in connect: " . join( " ", $result[ 1 .. $#result ] ) );
     271        do_logout($jidStr);
     272        delete $vars{jlogin_connhash};
     273        delete $vars{jlogin_authhash};
     274        return "";
     275    }
     276
    288277    $connections->{$jidStr}->{roster}->fetch();
    289     $$client->PresenceSend(priority => 1);
     278    $$client->PresenceSend( priority => 1 );
    290279    queue_admin_msg("Connected to jabber as $jidStr");
    291280    delete $vars{jlogin_connhash};
    … …  
    294283}
    295284
    296 sub do_logout
    297 {
     285sub do_logout {
    298286    my $jid = shift;
    299287    $connections->{$jid}->{client}->Disconnect();
    … …  
    302290}
    303291
    304 sub cmd_logout
    305 {
     292sub cmd_logout {
     293
    306294    # Logged into multiple accounts
    307     if (connected() > 1)
     295    if ( connected() > 1 ) {
     296
     297        # Logged into multiple accounts, no accout specified.
     298        if ( !$_[1] ) {
     299            my $errStr =
     300"You are logged into multiple accounts. Please specify an account to log out of.\n";
     301            foreach my $jid ( keys %$connections ) {
     302                $errStr .= "\t$jid\n";
     303            }
     304            queue_admin_msg($errStr);
     305        }
     306
     307        # Logged into multiple accounts, account specified.
     308        else {
     309            if ( $_[1] eq '-a' )    #All accounts.
     310            {
     311                foreach my $jid ( keys %$connections ) {
     312                    do_logout($jid);
     313                }
     314            }
     315            else                    #One account.
     316            {
     317                my $jid = resolveJID( $_[1] );
     318                do_logout($jid) if ( $jid ne '' );
     319            }
     320        }
     321    }
     322    else                            # Only one account logged in.
    308323    {
    309         # Logged into multiple accounts, no accout specified.
    310         if (!$_[1])
    311         {
    312             my $errStr = "You are logged into multiple accounts. Please specify an account to log out of.\n";
    313             foreach my $jid (keys %$connections)
    314             {
    315                 $errStr .= "\t$jid\n";
    316             }
    317             queue_admin_msg($errStr);
    318         }
    319         # Logged into multiple accounts, account specified.
    320         else
    321         {
    322             if ($_[1] eq '-a') #All accounts.
    323             {
    324                 foreach my $jid (keys %$connections)
    325                 {
    326                     do_logout($jid);
    327                 }
    328             }
    329             else #One account.
    330             {
    331                 my $jid = resolveJID($_[1]);
    332                 do_logout($jid) if ($jid ne '');
    333             }
    334         }
    335     }
    336     else # Only one account logged in.
    337     {
    338        
    339         do_logout((keys %$connections)[0]);
     324
     325        do_logout( ( keys %$connections )[0] );
    340326    }
    341327    return "";
    342328}
    343329
    344 sub cmd_jlist
    345 {
    346     if (!(scalar keys %$connections))
    347     {
    348         owl::error("You are not logged in to Jabber.");
    349         return;
    350     }
    351     owl::popless_ztext(onGetBuddyList());
    352 }
    353 
    354 sub cmd_jwrite
    355 {
    356     if (!connected())
    357     {
    358         owl::error("You are not logged in to Jabber.");
    359         return;
    360     }
    361 
    362     my $jwrite_to = "";
    363     my $jwrite_from = "";
    364     my $jwrite_thread = "";
     330sub cmd_jlist {
     331    if ( !( scalar keys %$connections ) ) {
     332        owl::error("You are not logged in to Jabber.");
     333        return;
     334    }
     335    owl::popless_ztext( onGetBuddyList() );
     336}
     337
     338sub cmd_jwrite {
     339    if ( !connected() ) {
     340        owl::error("You are not logged in to Jabber.");
     341        return;
     342    }
     343
     344    my $jwrite_to      = "";
     345    my $jwrite_from    = "";
     346    my $jwrite_thread  = "";
    365347    my $jwrite_subject = "";
    366     my $jwrite_type = "chat";
     348    my $jwrite_type    = "chat";
    367349
    368350    my @args = @_;
    … …  
    370352    local @ARGV = @_;
    371353    my $gc;
    372     GetOptions('thread=s' => \$jwrite_thread,
    373                'subject=s' => \$jwrite_subject,
    374                'account=s' => \$jwrite_from,
    375                'groupchat' => \$gc);
     354    GetOptions(
     355        'thread=s'  => \$jwrite_thread,
     356        'subject=s' => \$jwrite_subject,
     357        'account=s' => \$jwrite_from,
     358        'groupchat' => \$gc
     359    );
    376360    $jwrite_type = 'groupchat' if $gc;
    377361
    378     if (scalar @ARGV != 1)
     362    if ( scalar @ARGV != 1 ) {
     363        owl::error(
     364            "Usage: jwrite JID [-g] [-t thread] [-s 'subject'] [-a account]");
     365        return;
     366    }
     367    else {
     368        $jwrite_to = shift @ARGV;
     369    }
     370
     371    if ( !$jwrite_from ) {
     372        if ( connected() == 1 ) {
     373            $jwrite_from = ( keys %$connections )[0];
     374        }
     375        else {
     376            owl::error("Please specify an account with -a {jid}");
     377            return;
     378        }
     379    }
     380    else {
     381        $jwrite_from = resolveJID($jwrite_from);
     382        return unless $jwrite_from;
     383    }
     384
     385    $vars{jwrite} = {
     386        to      => $jwrite_to,
     387        from    => $jwrite_from,
     388        subject => $jwrite_subject,
     389        thread  => $jwrite_thread,
     390        type    => $jwrite_type
     391    };
     392
     393    owl::message(
     394"Type your message below.  End with a dot on a line by itself.  ^C will quit."
     395    );
     396    owl::start_edit_win( join( ' ', @args ), \&process_owl_jwrite );
     397}
     398
     399sub cmd_jmuc {
     400    die "You are not logged in to Jabber" unless connected();
     401    my $ocmd = shift;
     402    my $cmd  = shift;
     403    if ( !$cmd ) {
     404
     405        #XXX TODO: Write general usage for jmuc command.
     406        return;
     407    }
     408
     409    my %jmuc_commands = (
     410        join      => \&jmuc_join,
     411        part      => \&jmuc_part,
     412        invite    => \&jmuc_invite,
     413        configure => \&jmuc_configure
     414    );
     415    my $func = $jmuc_commands{$cmd};
     416    if ( !$func ) {
     417        owl::error("jmuc: Unknown command: $cmd");
     418        return;
     419    }
     420
    379421    {
    380         owl::error("Usage: jwrite JID [-g] [-t thread] [-s 'subject'] [-a account]");
    381         return;
    382     }
    383     else
    384     {
    385             $jwrite_to = shift @ARGV;
    386     }
    387 
    388     if (!$jwrite_from)
    389     {
    390         if (connected() == 1)
    391         {
    392             $jwrite_from = (keys %$connections)[0];
    393         }
    394         else
    395         {
    396             owl::error("Please specify an account with -a {jid}");
    397             return;
    398         }
    399     }
    400     else
    401     {
    402         $jwrite_from = resolveJID($jwrite_from);
    403         return unless $jwrite_from;
    404     }
    405    
    406     $vars{jwrite} = {to => $jwrite_to,
    407                      from => $jwrite_from,
    408                      subject => $jwrite_subject,
    409                      thread => $jwrite_thread,
    410                      type => $jwrite_type};
    411 
    412     owl::message("Type your message below.  End with a dot on a line by itself.  ^C will quit.");
    413     owl::start_edit_win(join(' ', @args), \&process_owl_jwrite);
    414 }
    415 
    416 sub cmd_jmuc
    417 {
    418         die "You are not logged in to Jabber" unless connected();
    419         my $ocmd = shift;
    420         my $cmd = shift;   
    421         if (!$cmd)
    422         {
    423                 #XXX TODO: Write general usage for jmuc command.
    424                 return;
    425         }
    426 
    427         my %jmuc_commands = (
    428                 join   => \&jmuc_join,
    429                 part   => \&jmuc_part,
    430                 invite => \&jmuc_invite,
    431                 configure => \&jmuc_configure
    432                );
    433         my $func = $jmuc_commands{$cmd};
    434         if(!$func) {
    435                 owl::error("jmuc: Unknown command: $cmd");
    436                 return;
    437         }
    438 
    439         {
    440                 local @ARGV = @_;
    441                 my $jid;
    442                 my $muc;
    443                 my $m = owl::getcurmsg();
    444                 if ($m->is_jabber && $m->{jtype} eq 'groupchat')
    445                 {
    446                         $muc = $m->{room};
    447                         $jid = $m->{to};
    448                 }
    449 
    450                 my $getopt = Getopt::Long::Parser->new;
    451                 $getopt->configure('pass_through');
    452                 $getopt->getoptions('account=s' => \$jid);
    453                 $jid ||= defaultJID();
    454                 if($jid) {
    455                         $jid = resolveJID($jid);
    456                         return unless $jid;
    457                 } else {
    458                         owl::error('You must specify an account with -a {jid}');
    459                 }
    460                 return $func->($jid, $muc, @ARGV);
    461         }
     422        local @ARGV = @_;
     423        my $jid;
     424        my $muc;
     425        my $m = owl::getcurmsg();
     426        if ( $m->is_jabber && $m->{jtype} eq 'groupchat' ) {
     427            $muc = $m->{room};
     428            $jid = $m->{to};
     429        }
     430
     431        my $getopt = Getopt::Long::Parser->new;
     432        $getopt->configure('pass_through');
     433        $getopt->getoptions( 'account=s' => \$jid );
     434        $jid ||= defaultJID();
     435        if ($jid) {
     436            $jid = resolveJID($jid);
     437            return unless $jid;
     438        }
     439        else {
     440            owl::error('You must specify an account with -a {jid}');
     441        }
     442        return $func->( $jid, $muc, @ARGV );
     443    }
    462444}
    463445
    464446sub jmuc_join {
    465         my ($jid, $muc, @args) = @_;
    466         local @ARGV = @args;
    467         my $password;
    468         GetOptions('password=s' => \$password);
    469 
    470         $muc = shift @ARGV or die("Usage: jmuc join {muc} [-p password] [-a account]");
    471 
    472         my $x = new XML::Stream::Node('x');
    473         $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc');
    474         $x->add_child('history')->put_attrib(maxchars => '0');
    475        
    476         if ($password)
    477         {
    478             $x->add_child('password')->add_cdata($password);
    479         }
    480 
    481         my $presence = new Net::Jabber::Presence;
    482         $presence->SetPresence(to => $muc);
    483         $presence->AddX($x);
    484         $connections->{$jid}->{client}->Send($presence);
     447    my ( $jid, $muc, @args ) = @_;
     448    local @ARGV = @args;
     449    my $password;
     450    GetOptions( 'password=s' => \$password );
     451
     452    $muc = shift @ARGV
     453      or die("Usage: jmuc join {muc} [-p password] [-a account]");
     454
     455    my $x = new XML::Stream::Node('x');
     456    $x->put_attrib( xmlns => 'http://jabber.org/protocol/muc' );
     457    $x->add_child('history')->put_attrib( maxchars => '0' );
     458
     459    if ($password) {
     460        $x->add_child('password')->add_cdata($password);
     461    }
     462
     463    my $presence = new Net::Jabber::Presence;
     464    $presence->SetPresence( to => $muc );
     465    $presence->AddX($x);
     466    $connections->{$jid}->{client}->Send($presence);
    485467}
    486468
    487469sub jmuc_part {
    488         my ($jid, $muc, @args) = @_;
    489 
    490         $muc = shift @args if scalar @args;
    491         die("Usage: jmuc part {muc} [-a account]") unless $muc;
    492 
    493         $connections->{$jid}->{client}->PresenceSend(to => $muc, type => 'unavailable');
    494         queue_admin_msg("$jid has left $muc.");
    495 }
    496 
    497 sub jmuc_invite
    498 {
    499         my ($jid, $muc, @args) = @_;
    500 
    501         my $invite_jid = shift @args;
    502         $muc = shift @args if scalar @args;
    503 
    504         die('Usage: jmuc invite {jid} [muc] [-a account]') unless $muc && $invite_jid;
    505        
    506         my $x = new XML::Stream::Node('x');
    507         $x->put_attrib(xmlns => 'http://jabber.org/protocol/muc#user');
    508         $x->add_child('invite')->put_attrib(to => $invite_jid);
    509        
    510         my $message = new Net::Jabber::Message;
    511         $message->SetTo($muc);
    512         $message->AddX($x);
    513         $connections->{$jid}->{client}->Send($message);
    514         queue_admin_msg("$jid has invited $invite_jid to $muc.");
     470    my ( $jid, $muc, @args ) = @_;
     471
     472    $muc = shift @args if scalar @args;
     473    die("Usage: jmuc part {muc} [-a account]") unless $muc;
     474
     475    $connections->{$jid}->{client}
     476      ->PresenceSend( to => $muc, type => 'unavailable' );
     477    queue_admin_msg("$jid has left $muc.");
     478}
     479
     480sub jmuc_invite {
     481    my ( $jid, $muc, @args ) = @_;
     482
     483    my $invite_jid = shift @args;
     484    $muc = shift @args if scalar @args;
     485
     486    die('Usage: jmuc invite {jid} [muc] [-a account]')
     487      unless $muc && $invite_jid;
     488
     489    my $x = new XML::Stream::Node('x');
     490    $x->put_attrib( xmlns => 'http://jabber.org/protocol/muc#user' );
     491    $x->add_child('invite')->put_attrib( to => $invite_jid );
     492
     493    my $message = new Net::Jabber::Message;
     494    $message->SetTo($muc);
     495    $message->AddX($x);
     496    $connections->{$jid}->{client}->Send($message);
     497    queue_admin_msg("$jid has invited $invite_jid to $muc.");
    515498}
    516499
    517500Net::Jabber::Namespaces::add_ns(
    518         ns  => "http://jabber.org/protocol/muc#owner",
    519         tag => 'query',
    520        );
     501    ns  => "http://jabber.org/protocol/muc#owner",
     502    tag => 'query',
     503);
    521504
    522505sub jmuc_configure {
    523         my ($jid, $muc, @args) = @_;
    524         $muc = shift @args if scalar @args;
    525         die("Usage: jmuc configure [muc]") unless $muc;
    526         my $iq = Net::Jabber::IQ->new();
    527         $iq->SetTo($muc);
    528         $iq->SetType('set');
    529         my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner");
    530         my $x = $query->NewChild("jabber:x:data");
    531         $x->SetType('submit');
    532 
    533         $connections->{$jid}->{client}->Send($iq);
    534         queue_admin_msg("Accepted default instant configuration for $muc");
    535 }
    536 
     506    my ( $jid, $muc, @args ) = @_;
     507    $muc = shift @args if scalar @args;
     508    die("Usage: jmuc configure [muc]") unless $muc;
     509    my $iq = Net::Jabber::IQ->new();
     510    $iq->SetTo($muc);
     511    $iq->SetType('set');
     512    my $query = $iq->NewQuery("http://jabber.org/protocol/muc#owner");
     513    my $x     = $query->NewChild("jabber:x:data");
     514    $x->SetType('submit');
     515
     516    $connections->{$jid}->{client}->Send($iq);
     517    queue_admin_msg("Accepted default instant configuration for $muc");
     518}
    537519
    538520################################################################################
    539521### Owl Callbacks
    540 sub process_owl_jwrite
    541 {
     522sub process_owl_jwrite {
    542523    my $body = shift;
    543524
    544525    my $j = new Net::XMPP::Message;
    545526    $body =~ s/\n\z//;
    546     $j->SetMessage(to => $vars{jwrite}{to},
    547                    from => $vars{jwrite}{from},
    548                    type => $vars{jwrite}{type},
    549                    body => $body
    550                    );
    551     $j->SetThread($vars{jwrite}{thread}) if ($vars{jwrite}{thread});
    552     $j->SetSubject($vars{jwrite}{subject}) if ($vars{jwrite}{subject});
    553    
    554     my $m = j2o($j, 'out');
    555     if ($vars{jwrite}{type} ne 'groupchat')
    556     {
    557         #XXX TODO: Check for displayoutgoing.
    558         owl::queue_message($m);
    559     }
    560     $connections->{$vars{jwrite}{from}}->{client}->Send($j);
     527    $j->SetMessage(
     528        to   => $vars{jwrite}{to},
     529        from => $vars{jwrite}{from},
     530        type => $vars{jwrite}{type},
     531        body => $body
     532    );
     533    $j->SetThread( $vars{jwrite}{thread} )   if ( $vars{jwrite}{thread} );
     534    $j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} );
     535
     536    my $m = j2o( $j, 'out' );
     537    if ( $vars{jwrite}{type} ne 'groupchat' ) {
     538
     539        #XXX TODO: Check for displayoutgoing.
     540        owl::queue_message($m);
     541    }
     542    $connections->{ $vars{jwrite}{from} }->{client}->Send($j);
    561543    delete $vars{jwrite};
    562544}
    … …  
    564546### XMPP Callbacks
    565547
    566 sub process_incoming_chat_message
    567 {
    568     my ($session, $j) = @_;
    569     owl::queue_message(j2o($j, 'in'));
    570 }
    571 
    572 sub process_incoming_error_message
    573 {
    574     my ($session, $j) = @_;
    575     my %jhash = j2hash($j, 'in');
     548sub process_incoming_chat_message {
     549    my ( $session, $j ) = @_;
     550    owl::queue_message( j2o( $j, 'in' ) );
     551}
     552
     553sub process_incoming_error_message {
     554    my ( $session, $j ) = @_;
     555    my %jhash = j2hash( $j, 'in' );
    576556    $jhash{type} = 'admin';
    577     owl::queue_message(owl::Message->new(%jhash));
    578 }
    579 
    580 sub process_incoming_groupchat_message
    581 {
    582     my ($session, $j) = @_;
     557    owl::queue_message( owl::Message->new(%jhash) );
     558}
     559
     560sub process_incoming_groupchat_message {
     561    my ( $session, $j ) = @_;
     562
    583563    # HACK IN PROGRESS (ignoring delayed messages)
    584     return if ($j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay'));
    585     owl::queue_message(j2o($j, 'in'));
    586 }
    587 
    588 sub process_incoming_headline_message
    589 {
    590     my ($session, $j) = @_;
    591     owl::queue_message(j2o($j, 'in'));
    592 }
    593 
    594 sub process_incoming_normal_message
    595 {
    596     my ($session, $j) = @_;
    597     my %props = j2hash($j, 'in');
     564    return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') );
     565    owl::queue_message( j2o( $j, 'in' ) );
     566}
     567
     568sub process_incoming_headline_message {
     569    my ( $session, $j ) = @_;
     570    owl::queue_message( j2o( $j, 'in' ) );
     571}
     572
     573sub process_incoming_normal_message {
     574    my ( $session, $j ) = @_;
     575    my %props = j2hash( $j, 'in' );
    598576
    599577    # XXX TODO: handle things such as MUC invites here.
    600578
    601 #    if ($j->HasX('http://jabber.org/protocol/muc#user'))
    602 #    {
    603 #       my $x = $j->GetX('http://jabber.org/protocol/muc#user');
    604 #       if ($x->HasChild('invite'))
    605 #       {
    606 #           $props         
    607 #       }
    608 #    }
    609 #   
    610     owl::queue_message(owl::Message->new(%props));
    611 }
    612 
    613 sub process_muc_presence
    614 {
    615     my ($session, $p) = @_;
    616     return unless ($p->HasX('http://jabber.org/protocol/muc#user'));
    617    
    618 }
    619 
     579    #    if ($j->HasX('http://jabber.org/protocol/muc#user'))
     580    #    {
     581    #   my $x = $j->GetX('http://jabber.org/protocol/muc#user');
     582    #   if ($x->HasChild('invite'))
     583    #   {
     584    #       $props
     585    #   }
     586    #    }
     587    #
     588    owl::queue_message( owl::Message->new(%props) );
     589}
     590
     591sub process_muc_presence {
     592    my ( $session, $p ) = @_;
     593    return unless ( $p->HasX('http://jabber.org/protocol/muc#user') );
     594
     595}
    620596
    621597### Helper functions
    622598
    623 sub j2hash
    624 {
    625     my $j = shift;
     599sub j2hash {
     600    my $j   = shift;
    626601    my $dir = shift;
    627602
    628     my %props = (type => 'jabber',
    629                  direction => $dir);
     603    my %props = (
     604        type      => 'jabber',
     605        direction => $dir
     606    );
    630607
    631608    my $jtype = $props{jtype} = $j->GetType();
    632     my $from  = $j->GetFrom('jid');
    633     my $to    = $j->GetTo('jid');
     609    my $from = $j->GetFrom('jid');
     610    my $to   = $j->GetTo('jid');
    634611
    635612    $props{from} = $from->GetJID('full');
    … …  
    638615    $props{recipient}  = $to->GetJID('base');
    639616    $props{sender}     = $from->GetJID('base');
    640     $props{subject}    = $j->GetSubject() if ($j->DefinedSubject());
    641     $props{thread}     = $j->GetThread() if ($j->DefinedThread());
    642     $props{body}       = $j->GetBody() if ($j->DefinedBody());
    643     $props{error}      = $j->GetError() if ($j->DefinedError());
    644     $props{error_code} = $j->GetErrorCode() if ($j->DefinedErrorCode());
     617    $props{subject}    = $j->GetSubject() if ( $j->DefinedSubject() );
     618    $props{thread}     = $j->GetThread() if ( $j->DefinedThread() );
     619    $props{body}       = $j->GetBody() if ( $j->DefinedBody() );
     620    $props{error}      = $j->GetError() if ( $j->DefinedError() );
     621    $props{error_code} = $j->GetErrorCode() if ( $j->DefinedErrorCode() );
    645622    $props{xml}        = $j->GetXML();
    646623
    647     if ($jtype eq 'chat')
    648     {
    649         $props{replycmd} = "jwrite ".(($dir eq 'in') ? $props{from} : $props{to});
    650         $props{replycmd} .= " -a ".(($dir eq 'out') ? $props{from} : $props{to});
    651         $props{isprivate} = 1;
    652     }
    653     elsif ($jtype eq 'groupchat')
    654     {
    655         my $nick = $props{nick} = $from->GetResource();
    656         my $room = $props{room} = $from->GetJID('base');
    657         $props{replycmd} = "jwrite -g $room";
    658         $props{replycmd} .= " -a ".(($dir eq 'out') ? $props{from} : $props{to});
    659        
    660         $props{sender} = $nick || $room;
    661         $props{recipient} = $room;
    662 
    663         if ($props{subject} && !$props{body})
    664         {
    665             $props{body} = '['.$nick." has set the topic to: ".$props{subject}."]"
    666         }
    667     }
    668     elsif ($jtype eq 'normal')
    669     {
    670         $props{replycmd} = undef;
    671         $props{isprivate} = 1;
    672     }
    673     elsif ($jtype eq 'headline')
    674     {
    675         $props{replycmd} = undef;
    676     }
    677     elsif ($jtype eq 'error')
    678     {
    679         $props{replycmd} = undef;
    680         $props{body} = "Error ".$props{error_code}." sending to ".$props{from}."\n".$props{error};
    681     }
    682    
     624    if ( $jtype eq 'chat' ) {
     625        $props{replycmd} =
     626          "jwrite " . ( ( $dir eq 'in' ) ? $props{from} : $props{to} );
     627        $props{replycmd} .=
     628          " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} );
     629        $props{isprivate} = 1;
     630    }
     631    elsif ( $jtype eq 'groupchat' ) {
     632        my $nick = $props{nick} = $from->GetResource();
     633        my $room = $props{room} = $from->GetJID('base');
     634        $props{replycmd} = "jwrite -g $room";
     635        $props{replycmd} .=
     636          " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} );
     637
     638        $props{sender} = $nick || $room;
     639        $props{recipient} = $room;
     640
     641        if ( $props{subject} && !$props{body} ) {
     642            $props{body} =
     643              '[' . $nick . " has set the topic to: " . $props{subject} . "]";
     644        }
     645    }
     646    elsif ( $jtype eq 'normal' ) {
     647        $props{replycmd}  = undef;
     648        $props{isprivate} = 1;
     649    }
     650    elsif ( $jtype eq 'headline' ) {
     651        $props{replycmd} = undef;
     652    }
     653    elsif ( $jtype eq 'error' ) {
     654        $props{replycmd} = undef;
     655        $props{body}     = "Error "
     656          . $props{error_code}
     657          . " sending to "
     658          . $props{from} . "\n"
     659          . $props{error};
     660    }
     661
    683662    $props{replysendercmd} = $props{replycmd};
    684663    return %props;
    685664}
    686665
    687 sub j2o
    688 {
    689     return owl::Message->new(j2hash(@_));
    690 }
    691 
    692 sub queue_admin_msg
    693 {
     666sub j2o {
     667    return owl::Message->new( j2hash(@_) );
     668}
     669
     670sub queue_admin_msg {
    694671    my $err = shift;
    695     my $m = owl::Message->new(type => 'admin',
    696                               direction => 'none',
    697                               body => $err);
     672    my $m   = owl::Message->new(
     673        type      => 'admin',
     674        direction => 'none',
     675        body      => $err
     676    );
    698677    owl::queue_message($m);
    699678}
    700679
    701 sub boldify($)
    702 {
     680sub boldify($) {
    703681    my $str = shift;
    704682
    705     return '@b('.$str.')' if ( $str !~ /\)/ );
    706     return '@b<'.$str.'>' if ( $str !~ /\>/ );
    707     return '@b{'.$str.'}' if ( $str !~ /\}/ );
    708     return '@b['.$str.']' if ( $str !~ /\]/ );
     683    return '@b(' . $str . ')' if ( $str !~ /\)/ );
     684    return '@b<' . $str . '>' if ( $str !~ /\>/ );
     685    return '@b{' . $str . '}' if ( $str !~ /\}/ );
     686    return '@b[' . $str . ']' if ( $str !~ /\]/ );
    709687
    710688    my $txt = "\@b($str";
    711689    $txt =~ s/\)/\)\@b\[\)\]\@b\(/g;
    712     return $txt.')';
    713 }
    714 
    715 sub getServerFromJID
    716 {
     690    return $txt . ')';
     691}
     692
     693sub getServerFromJID {
    717694    my $jid = shift;
    718695    my $res = new Net::DNS::Resolver;
    719     my $packet = $res->search('_xmpp-client._tcp.'.$jid->GetServer(), 'srv');
    720 
    721     if ($packet) # Got srv record.
     696    my $packet =
     697      $res->search( '_xmpp-client._tcp.' . $jid->GetServer(), 'srv' );
     698
     699    if ($packet)    # Got srv record.
    722700    {
    723         my @answer = $packet->answer;
    724         return $answer[0]{target},
    725                 $answer[0]{port};
     701        my @answer = $packet->answer;
     702        return $answer[0]{target}, $answer[0]{port};
    726703    }
    727704
    … …  
    729706}
    730707
    731 sub connected
    732 {
     708sub connected {
    733709    return scalar keys %$connections;
    734710}
    735711
    736712sub defaultJID {
    737         return (keys %$connections)[0]  if (connected() == 1);
    738         return;
    739 }
    740 
    741 sub resolveJID
    742 {
     713    return ( keys %$connections )[0] if ( connected() == 1 );
     714    return;
     715}
     716
     717sub resolveJID {
    743718    my $givenJidStr = shift;
    744     my $givenJid = new Net::XMPP::JID;
     719    my $givenJid    = new Net::XMPP::JID;
    745720    $givenJid->SetJID($givenJidStr);
    746    
     721
    747722    # Account fully specified.
    748     if ($givenJid->GetResource())
    749     {
    750         # Specified account exists
    751         if (defined $connections->{$givenJidStr})
    752         {
    753             return $givenJidStr;
    754         }
    755         else #Specified account doesn't exist
    756         {
    757             owl::error("Invalid account: $givenJidStr");
    758         }
    759     }
     723    if ( $givenJid->GetResource() ) {
     724
     725        # Specified account exists
     726        if ( defined $connections->{$givenJidStr} ) {
     727            return $givenJidStr;
     728        }
     729        else    #Specified account doesn't exist
     730        {
     731            owl::error("Invalid account: $givenJidStr");
     732        }
     733    }
     734
    760735    # Disambiguate.
    761     else
    762     {
    763         my $matchingJid = "";
    764         my $errStr = "Ambiguous account reference. Please specify a resource.\n";
    765         my $ambiguous = 0;
    766        
    767         foreach my $jid (keys %$connections)
    768         {
    769             my $cJid = new Net::XMPP::JID;
    770             $cJid->SetJID($jid);
    771             if ($givenJidStr eq $cJid->GetJID('base'))
    772             {
    773                 $ambiguous = 1 if ($matchingJid ne "");
    774                 $matchingJid = $jid;
    775                 $errStr .= "\t$jid\n";
    776             }
    777         }
    778         # Need further disambiguation.
    779         if ($ambiguous)
    780         {
    781             queue_admin_msg($errStr);
    782         }
    783         # Not one of ours.
    784         elsif ($matchingJid eq "")
    785         {
    786             owl::error("Invalid account: $givenJidStr");
    787           }
    788         # Log out this one.
    789         else
    790         {
    791             return $matchingJid;
    792         }
     736    else {
     737        my $matchingJid = "";
     738        my $errStr =
     739          "Ambiguous account reference. Please specify a resource.\n";
     740        my $ambiguous = 0;
     741
     742        foreach my $jid ( keys %$connections ) {
     743            my $cJid = new Net::XMPP::JID;
     744            $cJid->SetJID($jid);
     745            if ( $givenJidStr eq $cJid->GetJID('base') ) {
     746                $ambiguous = 1 if ( $matchingJid ne "" );
     747                $matchingJid = $jid;
     748                $errStr .= "\t$jid\n";
     749            }
     750        }
     751
     752        # Need further disambiguation.
     753        if ($ambiguous) {
     754            queue_admin_msg($errStr);
     755        }
     756
     757        # Not one of ours.
     758        elsif ( $matchingJid eq "" ) {
     759            owl::error("Invalid account: $givenJidStr");
     760        }
     761
     762        # Log out this one.
     763        else {
     764            return $matchingJid;
     765        }
    793766    }
    794767    return "";
Note: See TracChangeset for help on using the changeset viewer.