1#!/usr/local/bin/perl -w
2
3###################################################################
4# Copyright 2000-02 Riad Wahby <rsw@jfet.org> All rights reserved #
5# This program is free software.  You may redistribute it and/or  #
6# modify it under the same terms as Perl itself.                  #
7###################################################################
8
9sub callback;
10sub callbacksi;
11
12# these are used to translate the status info
13# coming from the server.  See man page for more
14# info
15%com1 = (' ' => '',
16	 ''  => '',
17	 'A' => 'on AOL');
18%com2 = (' ' => '',
19	 ''  => '',
20	 'A' => 'Oscar Admin',
21	 'U' => 'Oscar Unconfirmed',
22	 'O' => 'Oscar Normal');
23%com3 = ("\0" => '',
24	 ''  => '',
25	 ' ' => '',
26	 'U' => 'Unavailable');
27
28use Net::AOLIM;
29
30print "Enter username: ";
31chomp ($username = <>);
32
33print "Enter password: ";
34chomp ($password = <>);
35
36$foo = Net::AOLIM->new("username" => $username,
37		       "password" => $password,
38		       "callback" => \&callback,
39		       "allow_srv_settings" => 0,
40		       "login_timeout" => 2 );
41
42print $foo->{'aim_agent'}, "\n";
43
44$foo->add_buddies("friends", $username);
45
46$foo->ui_add_fh(\*STDIN, \&callbacksi);
47
48$oldfh=select(STDIN);$|=1;select($oldfh);
49
50unless (defined($foo->signon))
51{
52    die "Error number was: $IM_ERR";
53}
54
55while (1)
56{
57    last unless defined($foo->ui_dataget(undef));
58}
59
60sub callback
61{
62    my $type = shift @_;
63
64    if ($type eq 'NICK')
65    {
66	$username = $_[0];
67    }
68    elsif ($type eq 'IM_IN')
69    {
70	if (($_[1] eq 't') || ($_[1] eq 'T'))
71	{
72	    print "\e[1;33mAuto Response \e[0m";
73	}
74	print "From:\e[1;31m $_[0]\e[0m  : $_[2]\n--\n";
75    }
76    elsif ($type eq 'UPDATE_BUDDY')
77    {
78	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($_[3]);
79	my $timestr = sprintf("%.2i:%.2i:%.2i", $hour , $min , $sec) . " " . sprintf("%.2i/%.2i/%.4i", $mon + 1, $mday, $year + 1900);
80	my ($c1, $c2, $c3) = split(//, $_[5]);
81	my $commentstr = join(' ', $com1{$c1}, $com2{$c2}, $com3{$c3});
82	print "Buddy \e[1;31m$_[0]\e[0m update: Online=$_[1] : Evil=$_[2] : Signon time=$timestr : Idle time=$_[4] : Comments=$commentstr :: $_[5]\n--\n";
83    }
84    elsif ($type eq 'ERROR')
85    {
86	$ERR_ARG = $_[1];
87	$ERROR = "$Net::AOLIM::ERROR_MSGS{$_[0]}";
88	$ERROR =~ s/\$ERR_ARG/$ERR_ARG/g;
89
90	print "\e[1;35mERROR!\e[0m : $_[0]: $ERROR\n--\n";
91    }
92    elsif ($type eq 'EVILED')
93    {
94	$_[1] ||= 'anonymous';
95	print "\e[1;4;37mEviled\e[0m by $_[1].  New evil is $_[0].\n--\n";
96    }
97    else
98    {
99	print $type, "\n", join("\n", @_), "\n";
100	return 0;
101    }
102}
103
104sub callbacksi
105{
106    my $recv_buffer;
107
108    unless (defined (sysread *STDIN, $recv_buffer, 65535))
109    {
110	die "Couldn't read STDIN!";
111    }
112
113    if ($recv_buffer =~ /^\/(.+?)\s/)
114    {
115	$command = $1;
116
117	if ($command =~ /im/i)
118	{
119	    my ($command, $message);
120	    ($command, $touser, $message) = split(' ', $recv_buffer, 3);
121	    $foo->toc_send_im($foo->norm_uname($touser), $message, 0);
122	}
123	elsif ($command =~ /evil/i)
124	{
125	    my ($command, @evils) = split(' ', $recv_buffer);
126
127	    if ($evils[0] =~ /^[01]$/)
128	    {
129		$anon = shift @evils;
130	    }
131	    else
132	    {
133		$anon = 0;
134	    }
135
136	    foreach $evil (@evils)
137	    {
138		$foo->toc_evil($evil,$anon);
139	    }
140	}
141	elsif ($command =~ /permitall/i)
142	{
143	    $foo->add_im_permit_all;
144	}
145	elsif ($command =~ /blockall/i)
146	{
147	    $foo->add_im_deny_all;
148	}
149	elsif ($command =~ /blocks/i)
150	{
151	    my @blocklist = $foo->current_denies;
152
153	    print "Deny list: ", join(' ', @blocklist), "\n";
154	}
155	elsif ($command =~ /permits/i)
156	{
157	    my @permitlist = $foo->current_permits;
158
159	    print "Permit list: ", join(' ', @permitlist), "\n";
160	}
161	elsif ($command =~ /block/i)
162	{
163	    my ($command, @blocklist) = split(' ', $recv_buffer);
164	    my (@addblocks, @removeblocks);
165
166	    foreach $block (@blocklist)
167	    {
168		if ($block =~ /^\+(.*)$/)
169		{
170		    push @addblocks, $1;
171		}
172		elsif ($block =~ /^-(.*)$/)
173		{
174		    push @removeblocks, $1;
175		}
176		else
177		{
178		    push @addblocks, $block;
179		}
180	    }
181
182	    if (scalar @addblocks)
183	    {
184		print "Adding Blocks ", join(' ', @addblocks), "\n";
185
186		$foo->add_im_deny(@addblocks);
187	    }
188
189	    if (scalar @removeblocks)
190	    {
191		my @denylist;
192		my %temp = ();
193
194		print "Removing Blocks ", join(' ', @removeblocks), "\n";
195
196		@denylist = $foo->current_denies;
197
198		map {$temp{$_} = 1;} @denylist;
199		map {delete $temp{$_};} @removeblocks;
200
201		@denylist = keys %temp;
202
203		$foo->add_im_deny_all;
204
205		$foo->add_im_deny(@denylist);
206	    }
207	}
208	elsif ($command =~ /permit/i)
209	{
210	    my ($command, @permitlist) = split(' ', $recv_buffer);
211	    my (@addpermits, @removepermits);
212
213	    foreach $permit (@permitlist)
214	    {
215		if ($permit =~ /^\+(.*)$/)
216		{
217		    push @addpermits, $1;
218		}
219		elsif ($permit =~ /^-(.*)$/)
220		{
221		    push @removepermits, $1;
222		}
223		else
224		{
225		    push @addpermits, $permit;
226		}
227	    }
228
229	    if (scalar @addpermits)
230	    {
231		print "Adding Permits ", join(' ', @addpermits), "\n";
232
233		$foo->add_im_permit(@addpermits);
234	    }
235
236	    if (scalar @removepermits)
237	    {
238		my @permitlist;
239		my %temp = ();
240
241		print "Removing Permits ", join(' ', @removepermits), "\n";
242
243		@permitlist = $foo->current_permits;
244
245		map {$temp{$_} = 1;} @permitlist;
246		map {delete $temp{$_};} @removepermits;
247
248		@permitlist = keys %temp;
249
250		$foo->add_im_deny_all;
251
252		$foo->add_im_permit(@permitlist);
253	    }
254	}
255	elsif ($command =~ /buddy/i)
256	{
257	    my ($command, @buddies) = split(' ', $recv_buffer);
258	    my (@addbuddies, @removebuddies);
259
260	    foreach $buddy (@buddies)
261	    {
262		if ($buddy =~ /^\+(.*)$/)
263		{
264		    push @addbuddies, $1;
265		}
266		elsif ($buddy =~ /^-(.*)$/)
267		{
268		    push @removebuddies, $1;
269		}
270		else
271		{
272		    push @addbuddies, $buddy;
273		}
274	    }
275
276	    if (scalar @removebuddies)
277	    {
278		print "Removing buddies ", join(' ', @removebuddies), "\n";
279
280		$foo->remove_online_buddies(@removebuddies);
281	    }
282
283	    if (scalar @addbuddies)
284	    {
285		unless ($group)
286		{
287		    print "Please set the group into which to add buddies first with the /group command!\n";
288		    return;
289		}
290
291		print "Adding buddies ", join(' ', @addbuddies), " to group $group\n";
292
293		$foo->add_online_buddies($group, @addbuddies);
294	    }
295	}
296	elsif ($command =~ /buddies/i)
297	{
298	    my %buddyhash;
299
300	    $foo->current_buddies(\%buddyhash);
301
302	    foreach $key (keys %buddyhash)
303	    {
304		print "g $key\n";
305		foreach $buddy (@{$buddyhash{$key}})
306		{
307		    print "b $buddy\n";
308		}
309	    }
310	}
311	elsif ($command =~ /group/i)
312	{
313	    ($command, $group) = split(' ', $recv_buffer, 2);
314	    chomp $group;
315	}
316	elsif (($command =~ /quit/i) || ($command =~ /exit/i))
317	{
318	    print "Really exit [y/N]: ";
319	    $answer = <STDIN>;
320
321	    if ($answer =~ /^y/i)
322	    {
323		exit;
324	    }
325	    else
326	    {
327		print "Whew!  I got nervous there for a second :-)\n";
328	    }
329	}
330    }
331    else
332    {
333# we assume everything else is just an IM to the last person we IMed
334	$foo->toc_send_im($touser, $recv_buffer);
335    }
336}
337