Changeset f62550d for perl


Ignore:
Timestamp:
Dec 24, 2006, 2:15:05 PM (18 years ago)
Author:
Alejandro R. Sedeño <asedeno@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:
5c9c27d
Parents:
23be736
Message:
Updates I've had pending for a while.

* First pass of Roster support
* Redesigning the connection storage as an object.
* Tweaking admin messages to allow reply actions. (Useful for Roster Management)
Possibly a few other things I'm forgetting.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • perl/modules/jabber.pl

    r84296f6 rf62550d  
    2626################################################################################
    2727
    28 our $connections;
     28
     29################################################################################
     30################################################################################
     31package owl_jabber::ConnectionManager;
     32sub new {
     33    my $class = shift;
     34    return bless { }, $class;
     35}
     36
     37sub addConnection {
     38    my $self = shift;
     39    my $jidStr = shift;
     40
     41    $self->{Client}->{$jidStr} =
     42      Net::Jabber::Client->new(
     43          debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,
     44          debugfile => 'jabber.log'
     45      );
     46    my $refConn = \$self->{Client}->{$jidStr};
     47    $self->{Roster}->{$jidStr} = $$refConn->Roster();
     48    return $refConn;
     49}
     50
     51sub removeConnection {
     52    my $self = shift;
     53    my $jidStr = shift;
     54    my $ret = 0;
     55    foreach my $j ( keys %{ $self->{Client} } ) {
     56        if ($j eq $jidStr) {
     57            $self->{Client}->{$j}->Disconnect();
     58            delete $self->{Roster}->{$j};
     59            delete $self->{Client}->{$j};
     60            $ret = 1;
     61        }
     62    }
     63    return $ret;
     64}
     65
     66sub connected {
     67    my $self = shift;
     68    return scalar keys %{ $self->{Client} };
     69}
     70
     71sub getJids {
     72    my $self = shift;
     73    return keys %{ $self->{Client} };
     74}
     75
     76sub jidExists {
     77    my $self = shift;
     78    my $jidStr = shift;
     79    foreach my $j ( keys %{ $self->{Client} } ) {
     80        return 1 if ($j eq $jidStr);
     81    }
     82    return 0;
     83}
     84
     85sub sidExists {
     86    my $self = shift;
     87    my $sid = shift || "";
     88    foreach my $j ( keys %{ $self->{Client} } ) {
     89        return 1 if ($self->{Client}->{$j}->{SESSION}->{id} eq $sid);
     90    }
     91    return 0;
     92}
     93
     94sub getConnRefFromSid {
     95    my $self = shift;
     96    my $sid = shift;
     97    foreach my $j ( keys %{ $self->{Client} } ) {
     98        if ($self->{Client}->{$j}->{SESSION}->{id} eq $sid) {
     99            return \$self->{Client}->{$j};
     100        }
     101    }
     102    return undef;
     103}
     104
     105sub getConnRefFromJidStr {
     106    my $self = shift;
     107    my $jidStr = shift;
     108    foreach my $j ( keys %{ $self->{Client} } ) {
     109        if ($jidStr eq $j) {
     110            return \$self->{Client}->{$j};
     111        }
     112    }
     113    return undef;
     114}
     115
     116sub getRosterRefFromSid {
     117    my $self = shift;
     118    my $sid = shift;
     119    foreach my $j ( keys %{ $self->{Client} } ) {
     120        if ($self->{Client}->{$j}->{SESSION}->{id} eq $sid) {
     121            return \$self->{Roster}->{$j};
     122        }
     123    }
     124    return undef;
     125}
     126
     127sub getRosterRefFromJidStr {
     128    my $self = shift;
     129    my $jidStr = shift;
     130    foreach my $j ( keys %{ $self->{Client} } ) {
     131        if ($jidStr eq $j) {
     132            return \$self->{Roster}->{$j};
     133        }
     134    }
     135    return undef;
     136}
     137################################################################################
     138
     139package owl_jabber;
     140
     141our $conn = new owl_jabber::ConnectionManager unless $conn;;
    29142our %vars;
    30143
    … …  
    45158
    46159sub onMainLoop {
    47     return if ( !connected() );
    48 
    49     foreach my $jid ( keys %$connections ) {
    50         my $client = \$connections->{$jid}->{client};
     160    return if ( !$conn->connected() );
     161
     162    foreach my $jid ( $conn->getJids() ) {
     163        my $client = $conn->getConnRefFromJidStr($jid);
    51164
    52165        my $status = $$client->Process(0);
    … …  
    69182    my $res = $$roster->resource($buddy);
    70183
    71     $blistStr .= $jq{name} ? $jq{name} : $buddy->GetJID();
     184    $blistStr .= $jq{name} ? $jq{name} . "\t(" .$buddy->GetJID() . ')' : $buddy->GetJID();
    72185
    73186    if ($res) {
    … …  
    96209    return "" unless $jid;
    97210    my $blist = "";
    98     my $roster = \$connections->{$jid}->{roster};
     211    my $roster = $conn->getRosterRefFromJidStr($jid);
    99212    if ($$roster) {
    100213        $blist .= "\n" . boldify("Jabber Roster for $jid\n");
    … …  
    120233sub onGetBuddyList {
    121234    my $blist = "";
    122     foreach my $jid (keys %{$connections}) {
     235    foreach my $jid ($conn->getJids()) {
    123236        $blist .= getSingleBuddyList($jid);
    124237    }
    … …  
    169282        }
    170283    );
     284    owl::new_command(
     285        jroster => \&cmd_jroster,
     286        {
     287            summary     => "Jabber Roster related commands.",
     288            description => "jroster sends jabber commands related to rosters.\n\n",
     289            usage       => "jroster {command} {args}"
     290        }
     291    );
    171292}
    172293
    … …  
    187308    }
    188309
    189     if ( $connections->{$jidStr} ) {
     310    if ( $conn->jidExists($jidStr) ) {
    190311        owl::error("Already logged in as $jidStr.");
    191312        return;
    … …  
    219340    else
    220341    {
    221         $connections->{$jidStr}->{client} = Net::Jabber::Client->new(
    222             debuglevel => owl::getvar('debug') eq 'on' ? 1 : 0,
    223             debugfile => 'jabber.log'
    224         );
    225         my $client = \$connections->{$jidStr}->{client};
    226         $connections->{$jidStr}->{roster} =
    227           $connections->{$jidStr}->{client}->Roster();
     342        my $client = $conn->addConnection($jidStr);
    228343
    229344        #XXX Todo: Add more callbacks.
    … …  
    237352        );
    238353        $$client->SetPresenceCallBacks(
    239             subscribe   => sub { owl_jabber::process_presence_subscribe(@_) },
    240             unsubscribe => sub { owl_jabber::process_presence_unsubscribe(@_) });
     354#            available    => sub { owl_jabber::process_presence_available(@_) },
     355#            unavailable  => sub { owl_jabber::process_presence_available(@_) },
     356            subscribe    => sub { owl_jabber::process_presence_subscribe(@_) },
     357            subscribed   => sub { owl_jabber::process_presence_subscribed(@_) },
     358            unsubscribe  => sub { owl_jabber::process_presence_unsubscribe(@_) },
     359            unsubscribed => sub { owl_jabber::process_presence_unsubscribed(@_) });
    241360
    242361        my $status = $$client->Connect( %{ $vars{jlogin_connhash} } );
    243362        if ( !$status ) {
    244             delete $connections->{$jidStr};
     363            $conn->removeConnection($jidStr);
    245364            owl::error("We failed to connect");
    246365        }
    … …  
    251370            if ( !$vars{jlogin_havepass} && $result[0] == 401 ) {
    252371                $vars{jlogin_havepass} = 1;
    253                 delete $connections->{$jidStr};
     372                $conn->removeConnection($jidStr);
    254373                owl::start_password( "Password for $jidStr: ", \&do_login );
    255374                return "";
    256375            }
    257             delete $connections->{$jidStr};
     376            $conn->removeConnection($jidStr);
    258377            owl::error(
    259378                "Error in connect: " . join( " ", @result ) );
    260379        }
    261380            else {
    262                 $connections->{$jidStr}->{roster}->fetch();
     381                ${ $conn->getRosterRefFromJidStr($jidStr) }->fetch();
    263382                $$client->PresenceSend( priority => 1 );
    264383                queue_admin_msg("Connected to jabber as $jidStr");
    … …  
    277396sub do_logout {
    278397    my $jid = shift;
    279     $connections->{$jid}->{client}->Disconnect();
    280     delete $connections->{$jid};
    281     queue_admin_msg("Jabber disconnected ($jid).");
     398    my $disconnected = $conn->removeConnection($jid);
     399    queue_admin_msg("Jabber disconnected ($jid).") if $disconnected;
    282400}
    283401
    284402sub cmd_logout {
    285403    # Logged into multiple accounts
    286     if ( connected() > 1 ) {
     404    if ( $conn->connected() > 1 ) {
    287405        # Logged into multiple accounts, no accout specified.
    288406        if ( !$_[1] ) {
    289407            my $errStr =
    290408              "You are logged into multiple accounts. Please specify an account to log out of.\n";
    291             foreach my $jid ( keys %$connections ) {
     409            foreach my $jid ( $conn->getJids() ) {
    292410                $errStr .= "\t$jid\n";
    293411            }
    … …  
    298416            if ( $_[1] eq '-a' )    #All accounts.
    299417            {
    300                 foreach my $jid ( keys %$connections ) {
     418                foreach my $jid ( $conn->getJids() ) {
    301419                    do_logout($jid);
    302420                }
    … …  
    311429    else                            # Only one account logged in.
    312430    {
    313         do_logout( ( keys %$connections )[0] );
     431        do_logout( ( $conn->getJids() )[0] );
    314432    }
    315433    return "";
    … …  
    317435
    318436sub cmd_jlist {
    319     if ( !( scalar keys %$connections ) ) {
     437    if ( !( scalar $conn->getJids() ) ) {
    320438        owl::error("You are not logged in to Jabber.");
    321439        return;
    … …  
    325443
    326444sub cmd_jwrite {
    327     if ( !connected() ) {
     445    if ( !$conn->connected() ) {
    328446        owl::error("You are not logged in to Jabber.");
    329447        return;
    … …  
    332450    my $jwrite_to      = "";
    333451    my $jwrite_from    = "";
     452    my $jwrite_sid     = "";
    334453    my $jwrite_thread  = "";
    335454    my $jwrite_subject = "";
    … …  
    344463        'subject=s' => \$jwrite_subject,
    345464        'account=s' => \$jwrite_from,
     465        'id=s'     =>  \$jwrite_sid,
    346466        'groupchat' => \$gc
    347467    );
    … …  
    358478
    359479    if ( !$jwrite_from ) {
    360         if ( connected() == 1 ) {
    361             $jwrite_from = ( keys %$connections )[0];
     480        if ( $conn->connected() == 1 ) {
     481            $jwrite_from = ( $conn->getJids() )[0];
    362482        }
    363483        else {
    … …  
    374494        to      => $jwrite_to,
    375495        from    => $jwrite_from,
     496        sid     => $jwrite_sid,
    376497        subject => $jwrite_subject,
    377498        thread  => $jwrite_thread,
    … …  
    380501
    381502    owl::message(
    382         "Type your message below.  End with a dot on a line by itself.  ^C will quit."
    383        );
     503"Type your message below.  End with a dot on a line by itself.  ^C will quit."
     504    );
    384505    owl::start_edit_win( join( ' ', @args ), \&process_owl_jwrite );
    385506}
    386507
    387508sub cmd_jmuc {
    388     die "You are not logged in to Jabber" unless connected();
     509    die "You are not logged in to Jabber" unless $conn->connected();
    389510    my $ocmd = shift;
    390511    my $cmd  = shift;
    … …  
    449570    }
    450571
    451     $connections->{$jid}->{client}->Send($presence);
     572    ${ $conn->getConnRefFromJidStr($jid) }->Send($presence);
    452573}
    453574
    … …  
    458579    die("Usage: jmuc part {muc} [-a account]") unless $muc;
    459580
    460     $connections->{$jid}->{client}
     581    ${ $conn->getConnRefFromJidStr($jid) }
    461582      ->PresenceSend( to => $muc, type => 'unavailable' );
    462583    queue_admin_msg("$jid has left $muc.");
    … …  
    477598    $x->AddInvite();
    478599    $x->GetInvite()->SetTo($invite_jid);
    479     $connections->{$jid}->{client}->Send($message);
     600    ${ $conn->getConnRefFromJidStr($jid) }->Send($message);
    480601    queue_admin_msg("$jid has invited $invite_jid to $muc.");
    481602}
    … …  
    492613    $x->SetType('submit');
    493614
    494     $connections->{$jid}->{client}->Send($iq);
     615    ${ $conn->getConnRefFromJidStr($jid) }->Send($iq);
    495616    queue_admin_msg("Accepted default instant configuration for $muc");
     617}
     618
     619
     620#XXX TODO: Consider merging this with jmuc and selecting off the first two args.
     621sub cmd_jroster {
     622    die "You are not logged in to Jabber" unless $conn->connected();
     623    my $ocmd = shift;
     624    my $cmd  = shift;
     625    if ( !$cmd ) {
     626
     627        #XXX TODO: Write general usage for jroster command.
     628        return;
     629    }
     630
     631    my %jroster_commands = (
     632        sub      => \&jroster_sub,
     633        unsub    => \&jroster_unsub,
     634        add      => \&jroster_add,
     635        remove   => \&jroster_remove,
     636        auth     => \&jroster_auth,
     637        deauth   => \&jroster_deauth
     638    );
     639
     640    my $func = $jroster_commands{$cmd};
     641    if ( !$func ) {
     642        owl::error("jroster: Unknown command: $cmd");
     643        return;
     644    }
     645
     646    {
     647        local @ARGV = @_;
     648        my $jid;
     649        my $name;
     650        my @groups;
     651        my $purgeGroups;
     652        my $getopt = Getopt::Long::Parser->new;
     653        $getopt->configure('pass_through');
     654        $getopt->getoptions(
     655            'account=s' => \$jid,
     656            'group=s' => \@groups,
     657            'purgegroups' => \$purgeGroups,
     658            'name=s' => \$name
     659        );
     660        $jid ||= defaultJID();
     661        if ($jid) {
     662            $jid = resolveJID($jid);
     663            return unless $jid;
     664        }
     665        else {
     666            owl::error('You must specify an account with -a {jid}');
     667        }
     668        return $func->( $jid, $name, \@groups, $purgeGroups,  @ARGV );
     669    }
     670}
     671
     672sub jroster_sub {
     673    my $jid = shift;
     674    my $name = shift;
     675    my @groups = @{ shift() };
     676    my $purgeGroups = shift;
     677    my $baseJid = baseJID($jid);
     678
     679    my $roster = $conn->getRosterRefFromJidStr($jid);
     680
     681    # Adding lots of users with the same name is a bad idea.
     682    $name = "" unless (1 == scalar(@ARGV));
     683
     684    my $p = new Net::XMPP::Presence;
     685    $p->SetType('subscribe');
     686
     687    foreach my $to (@ARGV) {
     688        jroster_add($jid, $name, \@groups, $purgeGroups, ($to)) unless ($$roster->exists($to));
     689
     690        $p->SetTo($to);
     691        ${ $conn->getConnRefFromJidStr($jid) }->Send($p);
     692        queue_admin_msg("You ($baseJid) have requested a subscription to ($to)'s presence.");
     693    }
     694}
     695
     696sub jroster_unsub {
     697    my $jid = shift;
     698    my $name = shift;
     699    my @groups = @{ shift() };
     700    my $purgeGroups = shift;
     701    my $baseJid = baseJID($jid);
     702
     703    my $p = new Net::XMPP::Presence;
     704    $p->SetType('unsubscribe');
     705    foreach my $to (@ARGV) {
     706        $p->SetTo($to);
     707        ${ $conn->getConnRefFromJidStr($jid) }->Send($p);
     708        queue_admin_msg("You ($baseJid) have unsubscribed from ($to)'s presence.");
     709    }
     710}
     711
     712sub jroster_add {
     713    my $jid = shift;
     714    my $name = shift;
     715    my @groups = @{ shift() };
     716    my $purgeGroups = shift;
     717    my $baseJid = baseJID($jid);
     718
     719    my $roster = $conn->getRosterRefFromJidStr($jid);
     720
     721    # Adding lots of users with the same name is a bad idea.
     722    $name = "" unless (1 == scalar(@ARGV));
     723
     724    foreach my $to (@ARGV) {
     725        my %jq  = $$roster->query($to);
     726        my $iq = new Net::XMPP::IQ;
     727        $iq->SetType('set');
     728        my $item = new XML::Stream::Node('item');
     729        $iq->NewChild('jabber:iq:roster')->AddChild($item);
     730
     731        my %allGroups = ();
     732
     733        foreach my $g (@groups) {
     734            $allGroups{$g} = $g;
     735        }
     736
     737        unless ($purgeGroups) {
     738            foreach my $g (@{$jq{groups}}) {
     739                $allGroups{$g} = $g;
     740            }
     741        }
     742
     743        foreach my $g (keys %allGroups) {
     744            $item->add_child('group')->add_cdata($g);
     745        }
     746
     747        $item->put_attrib(jid => $to);
     748        $item->put_attrib(name => $name) if $name;
     749        ${ $conn->getConnRefFromJidStr($jid) }->Send($iq);
     750        my $msg = "$baseJid: "
     751          . ($name ? "$name ($to)" : "($to)")
     752          . " is on your roster in the following groups: { "
     753          . join(" , ", keys %allGroups)
     754          . " }";
     755        queue_admin_msg($msg);
     756    }
     757}
     758
     759sub jroster_remove {
     760    my $jid = shift;
     761    my $name = shift;
     762    my @groups = @{ shift() };
     763    my $purgeGroups = shift;
     764    my $baseJid = baseJID($jid);
     765
     766    my $iq = new Net::XMPP::IQ;
     767    $iq->SetType('set');
     768    my $item = new XML::Stream::Node('item');
     769    $iq->NewChild('jabber:iq:roster')->AddChild($item);
     770    $item->put_attrib(subscription=> 'remove');
     771    foreach my $to (@ARGV) {
     772        $item->put_attrib(jid => $to);
     773        ${ $conn->getConnRefFromJidStr($jid) }->Send($iq);
     774        queue_admin_msg("You ($baseJid) have removed ($to) from your roster.");
     775    }
     776}
     777
     778sub jroster_auth {
     779    my $jid = shift;
     780    my $name = shift;
     781    my @groups = @{ shift() };
     782    my $purgeGroups = shift;
     783    my $baseJid = baseJID($jid);
     784
     785    my $p = new Net::XMPP::Presence;
     786    $p->SetType('subscribed');
     787    foreach my $to (@ARGV) {
     788        $p->SetTo($to);
     789        ${ $conn->getConnRefFromJidStr($jid) }->Send($p);
     790        queue_admin_msg("($to) has been subscribed to your ($baseJid) presence.");
     791    }
     792}
     793
     794sub jroster_deauth {
     795    my $jid = shift;
     796    my $name = shift;
     797    my @groups = @{ shift() };
     798    my $purgeGroups = shift;
     799    my $baseJid = baseJID($jid);
     800
     801    my $p = new Net::XMPP::Presence;
     802    $p->SetType('unsubscribed');
     803    foreach my $to (@ARGV) {
     804        $p->SetTo($to);
     805        ${ $conn->getConnRefFromJidStr($jid) }->Send($p);
     806        queue_admin_msg("($to) has been unsubscribed from your ($baseJid) presence.");
     807    }
    496808}
    497809
    … …  
    509821        body => $body
    510822    );
     823
    511824    $j->SetThread( $vars{jwrite}{thread} )   if ( $vars{jwrite}{thread} );
    512825    $j->SetSubject( $vars{jwrite}{subject} ) if ( $vars{jwrite}{subject} );
    513826
    514     my $m = j2o( $j, 'out' );
     827    my $m = j2o( $j, { direction => 'out' } );
    515828    if ( $vars{jwrite}{type} ne 'groupchat' ) {
    516829
    … …  
    518831        owl::queue_message($m);
    519832    }
    520     $connections->{ $vars{jwrite}{from} }->{client}->Send($j);
     833
     834    if ($vars{jwrite}{sid} && $conn->sidExists( $vars{jwrite}{sid} )) {
     835        ${ $conn->getConnRefFromSid($vars{jwrite}{sid}) }->Send($j);
     836    }
     837    else {
     838        ${ $conn->getConnRefFromJidStr($vars{jwrite}{from}) }->Send($j);
     839    }
     840
    521841    delete $vars{jwrite};
    522842    owl::message("");   # Kludge to make the ``type your message...'' message go away
    … …  
    526846
    527847sub process_incoming_chat_message {
    528     my ( $session, $j ) = @_;
    529     owl::queue_message( j2o( $j, 'in' ) );
     848    my ( $sid, $j ) = @_;
     849    owl::queue_message( j2o( $j, { direction => 'in',
     850                                   sid => $sid } ) );
    530851}
    531852
    532853sub process_incoming_error_message {
    533     my ( $session, $j ) = @_;
    534     my %jhash = j2hash( $j, 'in' );
     854    my ( $sid, $j ) = @_;
     855    my %jhash = j2hash( $j, { direction => 'in',
     856                              sid => $sid } );
    535857    $jhash{type} = 'admin';
    536858    owl::queue_message( owl::Message->new(%jhash) );
    … …  
    538860
    539861sub process_incoming_groupchat_message {
    540     my ( $session, $j ) = @_;
     862    my ( $sid, $j ) = @_;
    541863
    542864    # HACK IN PROGRESS (ignoring delayed messages)
    543865    return if ( $j->DefinedX('jabber:x:delay') && $j->GetX('jabber:x:delay') );
    544     owl::queue_message( j2o( $j, 'in' ) );
     866    owl::queue_message( j2o( $j, { direction => 'in',
     867                                   sid => $sid } ) );
    545868}
    546869
    547870sub process_incoming_headline_message {
    548     my ( $session, $j ) = @_;
    549     owl::queue_message( j2o( $j, 'in' ) );
     871    my ( $sid, $j ) = @_;
     872    owl::queue_message( j2o( $j, { direction => 'in',
     873                                   sid => $sid } ) );
    550874}
    551875
    552876sub process_incoming_normal_message {
    553     my ( $session, $j ) = @_;
    554     my %props = j2hash( $j, 'in' );
     877    my ( $sid, $j ) = @_;
     878    my %jhash = j2hash( $j, { direction => 'in',
     879                              sid => $sid } );
    555880
    556881    # XXX TODO: handle things such as MUC invites here.
    … …  
    565890    #    }
    566891    #
    567     owl::queue_message( owl::Message->new(%props) );
     892    owl::queue_message( owl::Message->new(%jhash) );
    568893}
    569894
    570895sub process_muc_presence {
    571     my ( $session, $p ) = @_;
     896    my ( $sid, $p ) = @_;
    572897    return unless ( $p->HasX('http://jabber.org/protocol/muc#user') );
    573 
    574 }
     898}
     899
     900
     901sub process_presence_available {
     902    my ( $sid, $p ) = @_;
     903    my $from = $p->GetFrom();
     904    my $to = $p->GetTo();
     905    my $type = $p->GetType();
     906    my %props = (
     907        to => $to,
     908        from => $from,
     909        recipient => $to,
     910        sender => $from,
     911        type => 'jabber',
     912        jtype => $p->GetType(),
     913        status => $p->GetStatus(),
     914        show => $p->GetShow(),
     915        xml => $p->GetXML(),
     916        direction => 'in');
     917
     918    if ($type eq '' || $type eq 'available') {
     919        $props{body} = "$from is now online. ";
     920        $props{loginout} = 'login';
     921    }
     922    else {
     923        $props{body} = "$from is now offline. ";
     924        $props{loginout} = 'logout';
     925    }
     926    $props{replysendercmd} = $props{replycmd} = "jwrite $from -i $sid";
     927    owl::queue_message(owl::Message->new(%props));
     928}
     929
     930sub process_presence_subscribe {
     931    my ( $sid, $p ) = @_;
     932    my $from = $p->GetFrom();
     933    my $to = $p->GetTo();
     934    my %props = (
     935        to => $to,
     936        from => $from,
     937        xml => $p->GetXML(),
     938        type => 'admin',
     939        adminheader => 'Jabber presence: subscribe',
     940        direction => 'in');
     941
     942    $props{body} = "The user ($from) wants to subscribe to your ($to) presence.\nReply (r) will authorize, reply-sender (R) will deny.";
     943    $props{replycmd} = "jroster auth $from -a $to";
     944    $props{replysendercmd} = "jroster deauth $from -a $to";
     945    owl::queue_message(owl::Message->new(%props));
     946}
     947
     948sub process_presence_unsubscribe {
     949    my ( $sid, $p ) = @_;
     950    my $from = $p->GetFrom();
     951    my $to = $p->GetTo();
     952    my %props = (
     953        to => $to,
     954        from => $from,
     955        xml => $p->GetXML(),
     956        type => 'admin',
     957        adminheader => 'Jabber presence: unsubscribe',
     958        direction => 'in');
     959
     960    $props{body} = "The user ($from) has been unsubscribed from your ($to) presence.\n";
     961    owl::queue_message(owl::Message->new(%props));
     962
     963    # Find a connection to reply with.
     964    foreach my $jid ($conn->getJids()) {
     965        my $cJid = new Net::XMPP::JID;
     966        $cJid->SetJID($jid);
     967        if ($to eq $cJid->GetJID('base') ||
     968            $to eq $cJid->GetJID('full')) {
     969            my $reply = $p->Reply(type=>"unsubscribed");
     970            ${ $conn->getConnRefFromJidStr($jid) }->Send($reply);
     971            return;
     972        }
     973    }
     974}
     975
     976sub process_presence_subscribed {
     977    my ( $sid, $p ) = @_;
     978    queue_admin_msg("ignoring:".$p->GetXML());
     979    # RFC 3921 says we should respond to this with a "subscribe"
     980    # but this causes a flood of sub/sub'd presence packets with
     981    # some servers, so we won't. We may want to detect this condition
     982    # later, and have per-server settings.
     983    return;
     984}
     985
     986sub process_presence_unsubscribed {
     987    my ( $sid, $p ) = @_;
     988    queue_admin_msg("ignoring:".$p->GetXML());
     989    # RFC 3921 says we should respond to this with a "subscribe"
     990    # but this causes a flood of unsub/unsub'd presence packets with
     991    # some servers, so we won't. We may want to detect this condition
     992    # later, and have per-server settings.
     993    return;
     994}
     995
    575996
    576997### Helper functions
    … …  
    578999sub j2hash {
    5791000    my $j   = shift;
    580     my $dir = shift;
    581 
    582     my %props = (
    583         type      => 'jabber',
    584         direction => $dir
    585     );
     1001    my %initProps = %{ shift() };
     1002
     1003    my $dir = 'none';
     1004    my %props = ( type => 'jabber' );
     1005
     1006    foreach my $k (keys %initProps) {
     1007        $dir = $initProps{$k} if ($k eq 'direction');
     1008        $props{$k} = $initProps{$k};
     1009    }
    5861010
    5871011    my $jtype = $props{jtype} = $j->GetType();
    … …  
    5911015    $props{from} = $from->GetJID('full');
    5921016    $props{to}   = $to->GetJID('full');
    593 
    594     my $account = ( $dir eq 'out' ) ? $props{from} : $props{to};
    5951017
    5961018    $props{recipient}  = $to->GetJID('base');
    … …  
    6051027    if ( $jtype eq 'chat' ) {
    6061028        $props{replycmd} =
    607           "jwrite " . ( ( $dir eq 'in' ) ? $props{from} : $props{to} ) . " -a $account";
     1029          "jwrite " . ( ( $dir eq 'in' ) ? $props{from} : $props{to} );
     1030        $props{replycmd} .=
     1031          " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} );
    6081032        $props{isprivate} = 1;
    609         $props{replysendercmd} = $props{replycmd};
    6101033    }
    6111034    elsif ( $jtype eq 'groupchat' ) {
    6121035        my $nick = $props{nick} = $from->GetResource();
    6131036        my $room = $props{room} = $from->GetJID('base');
    614         $props{replycmd} = "jwrite -g $room -a $account";
    615 
    616         $props{replysendercmd} = "jwrite " . $from->GetJID('full') . " -a $account";
     1037        $props{replycmd} = "jwrite -g $room";
     1038        $props{replycmd} .=
     1039          " -a " . ( ( $dir eq 'out' ) ? $props{from} : $props{to} );
    6171040
    6181041        $props{sender} = $nick || $room;
    … …  
    6401063    }
    6411064
     1065    $props{replysendercmd} = $props{replycmd};
    6421066    return %props;
    6431067}
    … …  
    6851109}
    6861110
    687 sub connected {
    688     return scalar keys %$connections;
    689 }
    690 
    6911111sub defaultJID {
    692     return ( keys %$connections )[0] if ( connected() == 1 );
     1112    return ( $conn->getJids() )[0] if ( $conn->connected() == 1 );
    6931113    return;
    6941114}
    … …  
    7081128    # Account fully specified.
    7091129    if ( $givenJid->GetResource() ) {
    710 
    7111130        # Specified account exists
    712         if ( defined $connections->{$givenJidStr} ) {
    713             return $givenJidStr;
    714         }
    715         else    #Specified account doesn't exist
    716         {
    717             owl::error("Invalid account: $givenJidStr");
    718         }
     1131        return $givenJidStr if ($conn->jidExists($givenJidStr) );
     1132        owl::error("Invalid account: $givenJidStr");
    7191133    }
    7201134
    … …  
    7261140        my $ambiguous = 0;
    7271141
    728         foreach my $jid ( keys %$connections ) {
     1142        foreach my $jid ( $conn->getJids() ) {
    7291143            my $cJid = new Net::XMPP::JID;
    7301144            $cJid->SetJID($jid);
Note: See TracChangeset for help on using the changeset viewer.