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