[standards-jig] WebPresence

Chris Josephes cpj1 at isis.visi.com
Fri Nov 1 13:41:58 UTC 2002


Here's the source code.  When it's finished, I was going to upload it to
CPAN.  I haven't touched it in awhile because I haven't been using my
Jabber server lately.

Suggestions for improvement are welcome.

#!/usr/local/bin/perl

# online-text
# Report on user presense using text/html output

#
# Compiler Directives
#

use strict;

#
# Includes
#

use Net::Jabber qw(Client);
use MIME::Base64;
use CGI;

#
# Global Variables
#

use vars qw/$Config $Client $File $DefIcons /;

$File="config.txt";

#
# Icon Image Data
#

#
# Available icon
$DefIcons->{available}->{type}="image/png";
$DefIcons->{available}->{b64}=<<EOB64
iVBORw0KGgoAAAANSUhEUgAAAGAAAAArCAIAAAAIZRrAAAAALHRFWHRDcmVhdGlvbiBUaW1lAFNh
dCAyMCBKdWwgMjAwMiAwNDo0NTozNSAtMDYwMK15bX8AAAAHdElNRQfSBxQJMQLZ+1ZNAAAACXBI
WXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAAAZ0Uk5TAPgAvwAk5ONB8QAAAiBJREFU
eNrtmk2SwiAQhdNWLuHOxRzCnRzAY8yx5hjuB3dzDHdeYXYZlClsfgINoaSjfGVZSICQx+smpgK/
3x/Dncv2NLRmdz22noILaIF+4Kv1TP7ZT5+tp2CxKegj5EF9KJUF8FkqzejMCV+kFOfW02uP6yAl
StcFMyZbzHnK1Mcr/e66RpVVgf9ipHOQ9hS+NlwfrzRa+C2rJKwnkOegMoIjRLzTPE/jnTQhkLHA
sEAp/nHkoFbIaFSyzb8DxsWWg/yEqlNp0DuUJO13X52bbnfSzWMeI4Rocl4ppVOjo4xXiLVSJ3Lq
Mav1a6Ou2vfRJtiu9VQZ4QrU1XHglYMY0gV64CQgvbmzEWi6fxY2Iw5CUEdz2Z7S/8Ws02ugkiK1
hqqKOAj1Lc9S/2TjIB5odXCBLBBe8FIbWwBH+/jkhFgQP1KcGkdNmO8YHNnv6ByNqxwf5BkCxZk8
7SbaLOMdJ+TlyID+UhHPjqCFGD5TVpQVBxHQjkYmU2kTWOwgsFcmHl90qqS5GuMUbfNZ7SF/hOKO
Ps9wUNCr2DVg36GtYW+is/L7oEiiCaanfCdWEgi8wmBvNFl/ApIdcT3kjJNyt7mBNgVCiAGtkths
7hDQOhJ3N2L7qEaalYdYPYIPwnbXYxfogaMRx4f2DOkCJegCJfDeDwo9WHsTgte+IbZ7eeauesxq
/Yb0HJTgJhC3N2854L4f1DXCYDXAvGnfCfIH1D/i6507ACoAAAAASUVORK5CYII=
EOB64
;

#
# Unavailable icon
$DefIcons->{unavailable}->{type}="image/png";
$DefIcons->{unavailable}->{b64}=<<EOB64
iVBORw0KGgoAAAANSUhEUgAAAGAAAAArCAIAAAAIZRrAAAAALHRFWHRDcmVhdGlvbiBUaW1lAFNh
dCAyMCBKdWwgMjAwMiAyMDo1NjoyNiAtMDYwMFtVvYQAAAAHdElNRQfSBxUBOQU56X87AAAACXBI
WXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAAAZ0Uk5TAPgAvwAk5ONB8QAAAgZJREFU
eNrtms11gzAMx4HHEPSWQ4forQyQMTpWx+g99NYxessKvbUOShUhO/4KIIX493ogqgzy35IwPOqf
w3M18v30UUmzO+6lQ+DUINBX/S4dyZmX3zfpECY0GWP64dX8xRgz0LNUQMtiopMc+k/p8OThGWRE
KbpQ2qDHtZxCu99oDweLOTYH+hcj3IMgp+jcqN1vRC1sz1ka1gqkZVAezjN4cke8T9M7aUAgTIHq
BqX01xHDrBBqlHObfwQwiycZZDdUaKXO3Ilp0vbwu8um005avOYpfd+LXHcYBmaBKtNVYlLqeC7d
JnlvGzNrO48ap590qIrgAhV1GLp6kEKKQBdYA4KbexHojN2eq/Etq16BhhF6EPSMtPvpR/BnxNP8
9DJ5V70XUBo8CD/Ni8cqS75AkEd0c0WnRLMM7OjPhkf6e85s/8s/qkpR/9YeZC6MRYtBoJHZgycJ
+ns8nZFQdZJCmk0g51KkVke8v8dzoZJcpAc51weKEdbZU18ZZ1507PwCpU4+3j9bViAvxVbdB/m7
75rEixvx0v6/NNg84/1Tz5/n6YkwdQoU/kZRye5jfdgWAX52Xad3oygFy1C9z2Ir4yyd3XFfBLrA
NNL40l4hRaAARaAA1vdB233XE8Q59ybSb/Ncm3Wb5P2AlB4U4CSQti9vNcC/DyoaUagaNX5pX3Dy
BwggT0lurH2LAAAAAElFTkSuQmCC
EOB64
;

#
# Away icon
$DefIcons->{away}->{type}="image/png";
$DefIcons->{away}->{b64}=<<EOB64
iVBORw0KGgoAAAANSUhEUgAAAGAAAAArCAIAAAAIZRrAAAAALHRFWHRDcmVhdGlvbiBUaW1lAFNh
dCAyMCBKdWwgMjAwMiAwNDo0Njo1MCAtMDYwMNIZ8FwAAAAHdElNRQfSBxQJMiuwZJ3iAAAACXBI
WXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAAAZ0Uk5TAPgAvwAk5ONB8QAAAmlJREFU
eNrtms1KAzEQxydlEUTFowgeetAHKB4UPDQP0Mfw6mP4Fn0MbwpuL1IE6QN4kV6qx1L8OChramrI
JtlkP6abtN0fwcbZ7G7mz8wkuyz5uj8GgK2z2/F4DBIE4BMOoF7ak17Nd3QS8Z/R490MTuQDe/A8
g6Tm2byS/nly6VuTFK0S59C4y1oeYwmGpO9bkxQRnxOLF+En71zs71x33n1Pzz+LFPuBba7RE53/
vRp1pt+7AI1A/wJ9wJFsfZie/v2+gRRTjJgORF/Y7Ub9dG5hfdaRzw0Tdw1iPvCme+s0Ci30kSgF
qwYi54jqnhivYIkd73VaXkkdAokQgApKhZ9HCkNpt1Fmmd8ERBSnIkgvqLyUGmMnT5HWT1+5aCLs
UcN7zstQSr3cN45jxcKzLKwU86WO5dZRodHrDfNaj6OWcZzvqQaEKlCjjkJYNShAkAVKklRbLZQC
xBf3JoIW6OWZ8XJ40wik0u1S1sS/mAKJnCJEtawKQhrRcT/NY6HLl8eoS+w83WIvgYcUM4aVMDqD
Ti7/xlBFVAdTIGVa+tT16dq1EONZR7T6Cb1IexFFxr9ATgnsGyslVHHzC7CKtLEEyBaRd4obWRcJ
Zx2sbxUrQQj7BmSBspZb+3jjcl7opkvKL0CpQXl8KzR143pXz8PdYBArHcwI0h3DCg3n1eRDFcNH
SMNBiCD7JkU/atzXZG12FPvyNkTGF2HtSc//Mo8CSvYpGoX40r466MG1bgKhE/Q+KD/LeyJRI8j4
Ym1DMPreyjlu7cnyOio0egNpirSDuUChfXkbAur3QY1GMrIahH9p35DFL7KYF9561CDwAAAAAElF
TkSuQmCC
EOB64
;

#
# Do Not Disturb icon
$DefIcons->{dnd}->{type}="image/png";
$DefIcons->{dnd}->{b64}=<<EOB64
iVBORw0KGgoAAAANSUhEUgAAAGAAAAArCAIAAAAIZRrAAAAALHRFWHRDcmVhdGlvbiBUaW1lAFNh
dCAyMCBKdWwgMjAwMiAwNDo0NjoyMCAtMDYwMNjc+UUAAAAHdElNRQfSBxQJMgFr31Q0AAAACXBI
WXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAAAZ0Uk5TAPgAvwAk5ONB8QAAAklJREFU
eNrtWktywyAMRRlforsseoju4gPkGD1Wj9F97V2P0V2u0B11QsMIIWNMAJHEb7KwFcmGx5P4jOH3
61Vd8PPyqaSxPx2lm0ABhqBv+JBuyT/e9Lt0ExzsEmL64TD9YowJaGeoDDrSJtzJoR+lmycPqqCJ
lI0XjG7RY05T1h42+uHGMl1PF+0PxnINMprCfcP2sNFy4XtmKVgVsE5BaWCfENCOeJ3GM+kCQVYC
6gam2s8jgmmELEcp0/wzwKrYUZBfUE0pZbUTU6T98LtT03klLZ7zGH3fi7x3GAZiMVnWVopJsRN4
dbfK+7Ex9drX0Y71k25qQ6AKysKOdm9hTRSgW4jzLIqCNQiufdBrolY5V0DxIk040ug3B+3dsiE6
N5ukAJnJveosZlNjTlngeoZDIGuW+eVZXU5Z25rmVa3KEsCh7w+oEDdHkBLlyFJjL4oTlDbjiOvI
oiBB2mMHZuwBsCHEWBTL50EJgBx/QTCkmsQq1aByo11aRzkVFJi2I2PbKT0W+VMMr2W0WzXuEUVq
kAEgjrBAyGJPcctCf19G7L7itPvMXKi9DsIrY+CmuZjuac6StvVrjiDSw7TRBo/KXKoZrxsOe1Ew
xeb6ZthptiqP7qZMQEHAbUrFwR6E7U/Hsitp5WkkIbmqkUg4Mof2+VPMn6SUa2EdwN1PkNtFjsIv
vQU5CYrcRkBcOBsCS1HZ0eJxR1Pwvg/iDtaeBGzfd5F+D4+5XnervJ8QWw1awJmg1r68bQH0+6CN
IwzMBtgv7Tew+AMg9uV/d4wi6AAAAABJRU5ErkJggg==
EOB64
;

#
# Extended away icon
$DefIcons->{xa}->{type}="image/png";
$DefIcons->{xa}->{b64}=<<EOB64
iVBORw0KGgoAAAANSUhEUgAAAGAAAAArCAIAAAAIZRrAAAAALHRFWHRDcmVhdGlvbiBUaW1lAFNh
dCAyMCBKdWwgMjAwMiAwNDo0NzoxMCAtMDYwMLmRlZgAAAAHdElNRQfSBxQJMxVoHrEIAAAACXBI
WXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAAAZ0Uk5TAPgAvwAk5ONB8QAAAk5JREFU
eNrtmkFywjAMRRMmh4Adix6iO3wAjtGD5CA9BnvMrsdgxxW6owZ1PEJ2bJPYkQx5w3RcIxP7R5IV
T9rf40dz57w5NNxsL3vuKVBaEOin/eaeyT+f1y/uKTywGjFG6Z35pHSOQM6tAjoyJ7xIrU7c0+OH
epARZdEF00UthnzK9oc73eHQY9qmIf9mxHMQ+BReG+4Pd1otXMssCWsGnvOgcXh/IeA77Hka76QR
gawLNBOUkh9HBHOHrEZjtvl3wHrxgwe5CRVSqdd3UpK0O7w6b7pV0uwxj1FKsVxXa016IMpkhRiX
OoFLd09ZvzZm1a4frbx23FMd5Nor88lrGYZ60Ah1yDzaXgfMhr4VS7xQTKS6lSeSTSAMdhbiOO5X
gNvjjvJeJcUyEZKAoFzMtotBzEfnZ1ZChPOKhTuJJRE6ajlOHeC8ORQJMdPGYgWmOzGPZknDhJ3u
zd+T6uHfIiGWzsTMlT3xgTrQAI2KFIqB8KmObB4UDSgcd6AdyVkpAwOd3t+cDn0Wk1wlFgWStA2x
5p6G1uv1HDkoJVuLRdbDqkCKCzRUGeJkMdRuUHkVNqhYoCmYlUPqZdwNywqE3Ycs0rtm8lwiIWfN
mqSzDLR7OTSarDqanYuhko4+c6Z402zxZaUBCoaYe3u9UUZIcQfvOcFEvAXg9rJnfhYLq1B6hyKQ
I1c4tK+4ki5xROkKJHqbDzDbAW6tAs0GzUHGx6qIshK+4z1UXCXavTxDq+6esn5DlhwU4SaQtDdv
JUDfD1o0wmA1Wvum/YKXP7MnlLd/nXwoAAAAAElFTkSuQmCC
EOB64
;

#
# Subroutines
#

# Read the configuration file

sub readConfig
{
my ($file)=shift;
my ($config,$line,$name,$value);
open (F, $file) || return undef;
while ($line=<F>)
{
        chop($line);
        ($name,$value)=split(/\s*:\s*/,$line,2);
        $config->{$name}=$value;
}
close(F);
return $config;
}


# Log into the Jabber server and authenticate ourself

sub login
{
my ($config)=@_;
my ($client,$result);
$client=Net::Jabber::Client->new();
$client->Connect( hostname => $config->{server}) ||
        die("Unable to connect to $config->{server}\n");
($result)=$client->AuthSend( username => $config->{user},
        password => $config->{pass} ,
        resource => "online_$$" );  # Attach PID to resource to prevent
overlap
if ($result ne "ok")
{
        die("Authentication failed\n");
}
$client->SetCallBacks("presence" => \&presenceCB);
return($client);
}

sub checkCache
{

return 0;
}

sub checkPresence
{
my ($client,$config)=@_;
my ($pres,$jid);
$client->PresenceSend();
print("Checking $config->{jid}\n");
$jid=Net::Jabber::JID->new($config->{jid});
$client->Process(2);
$client->Disconnect();
}

sub presenceCB
{
my ($sid)=shift;
my ($pres)=Net::Jabber::Presence->new(@_);
my ($from)=$pres->GetFrom();
$from=~s/\/.*//;
if ($from eq $Config->{jid})
{
        print("User: $from is online\n");
        print("JID: ",$pres->GetFrom(),"\n");
        print("Type: ",$pres->GetType(),"\n");
        print("Status: ",$pres->GetStatus(),"\n");
        print("Show: ",$pres->GetShow(),"\n");
        $Config->{presence}=lc($pres->GetStatus());
}
return;
}

sub reportPresence
{
my ($config)=@_;
if ($Cgi->query_string() eq "image")
{
        serveImage($config);
} else
{
        serveText($config);
}
return;
}

sub serveText
{
my ($config)=@_;
unless ($config->{presence})
{
        print("No presence data was returned\n");
        return;
}
my ($string)=$config->{"txt.format"};
$string=~s/%u/$config->{jid}/g;
$string=~s/%s/$config->{presence}/g;
$string=~s/%n/\n/g;
print ($string);
return;
}

sub serveImage
{
my ($config)=@_;

return;
}

#
# Main Program Block
#

# Get environmental data from CGI environment
$Cgi=CGI->new();

$File=$Cgi->path_translated();

# Read configuration file
($Config)=readConfig($File);

# Check cached data file
if (checkCache($Config))
{
        reportPresence($Config);
        exit 0;
}

# Log onto Jabber server

($Client)=login($Config);

# Check presense data
checkPresence($Client,$Config);

# Report output

reportPresence($Config);

#
# Exit Block
#
exit 0;

#
# POD Documentation
#

=head1 NAME

jbicon -- Jabber Presence Icon

=head1 SYNOPSIS

<body>
<img src="/cgi-bin/jbicon/config.txt">

<!-- exec cgi="/cgi-bin/jbcon/config.txt?text" -->

</body>

=head1 ABSTRACT

Jbicon displays an icon or text reporting the availability presence of a
Jabber user.  It logs on to a remote Jabber server and queries the
presence
of a particular JID.  Based on the return presence stream, it displays an
icons showing the user as Available, Away, Extended Away, Do Not Disturb,
or
Unavailable.

=head1 GRAPHICS OR TEXT RESULTS

Jbicon will let you specify custom images to report presence information.
In absense of custom images, it will use default images that are in the
source code of the program itself.

When you specify graphics files in the configuration file, the image type
will be determined by the file extension.

If you want your presence information returned as raw text, you can call
jbicon from a server side include exec/cgi tag.  Just make sure the query
string is set to the word "text".

=head1 CONFIGURATION

Jbicon is configured from a text file on the web server that identifies
the
JID we are interested in, what server we have to log into, and how it is
to report data back to the web browser.  The following are the
configuration
parameters for jbicon.

=over 4

=item Server: [jabber-server]

Specifies which Jabber server to connect to

=item User: [username]

=item Pass: [password]

Username and password credentials to login.

=item Jid:  [jid]

Which JID we are interested in checking the presence for.

=item cache.file: [filename]

Jbicon caches its presence data to a file, so successive hits within a
certain timeframe do not have the additional overhead of connecting to
the Jabber server.  This option specifies what file we read and write our
availability data to.

=item cache.timeout: [seconds]

How long we trust our cached data.

=item txt.format: [string]

When we want jbicon to return a text string, we want it to be in the
following format.  We can insert presence information into the string
by using "%s" to return the availability, "%u" to return the JID (without
the resource portion), and "%m" to return the custom message associated
with the return presence packet.

=item img.available: [image-file]

Graphics file to return when the JID's presence is set to "Available".

=item img.away: [image-file]

Graphics file to return when the JID's presence is set to "Away".

=item img.xa: [image-file]

Graphics file to return when the JID's presence is set to "Extended Away".

=item img.dnd: [image-file]

Graphics file to return when the JID's presence is set to "Do Not
Disturb".

=item img.unavailable: [image-file]

Graphics file to return when we cannot determine the JID's presence or we
cannot connect to the Jabber server.

=head1 TODO

The following features may be added to jbicon in a future release.

=over 4

=item XML config file

Consider putting the configuration file in XML format.

=item Base64 encoded icons

If we use an XML configuration file format, we can encode custom icons in
the file using base64 notation.

=back

=head1 AUTHOR

Chris Josephes, chrisj at onvoy.com

=head1 PREREQUISITES

This script requires the modules, C<CGI>, C<MIME::Base64>, C<Net::Jabber>,
C<File::Basename>.

=head1 SCRIPT CATEGORIES

This script can be found in the CPAN scripts area in the C<CGI> and
C<Web> categories.





More information about the Standards mailing list