1#!/usr/local/bin/perl5 2# client.pl v1.5 7 Oct 1997 Matthew Ramsey <mjr@blackened.com> 3# http://www.blackened.com/ircstats/ 4# A simple perl script I use to grab client info on IRC Servers. While 5# it was designed for connecting to an IRC Server, it can easily be 6# modified to be used for other purposes. 7# Special thanks to Chris Behrens and Doug McLaren. 8 9use Socket; 10 11$DEBUG = 0; 12 13if ($ARGV[0]) { 14 $irchost = $ARGV[0] ; 15} else { 16 print STDERR "Usage: $0 <irc server>\n" ; 17 exit 1 ; 18} 19 20 21#$irchost = "irc-e.primenet.com"; 22$ircport = "6666"; 23$nick1 = "alskdjf"; 24$nick2 = "aselkr"; 25 26($locclients, $totclients, $numserv, $numchan) = 27 getinfo($irchost, $ircport); 28$time = time(); 29print "$locclients\n"; 30print "$locclients\n"; 31print "$time\n"; 32print ""; 33 34exit; # We're done! 35 36sub connect_host 37{ 38 local($ip, $port) = @_; 39 40 ($d1, $d2, $proto) = getprotobyname("tcp"); 41 ($d1, $d2, $d3, $d4, $rawclient) = gethostbyname(`hostname`); 42 ($d1, $d2, $d3, $d4, $rawserver) = gethostbyname($ip); 43 $clientaddr = pack("Sna4x8", 2, 0, $rawclient); 44 $serveraddr = pack("Sna4x8", 2, $port, $rawserver); 45 socket(SOCKET, AF_INET, SOCK_STREAM, $proto) || die "No socket: $!"; 46 bind(SOCKET, $clientaddr); 47 connect(SOCKET, $serveraddr) || die "connect failed: $!"; 48 select(SOCKET); 49 $| = 1; 50 select(STDOUT); 51} 52 53sub getinfo 54{ 55 local($host, $port) = @_; 56 local($lc, $ts, $ns, $nc); 57 58 $lc = "0"; 59 $ts = "0"; 60 $ns = "0"; 61 $nc = "0"; 62 connect_host($host, $port); 63 print SOCKET "user efnet jskd fksj fkjs fkjsfk jfk\nnick 64$nick1\nlusers\n"; 65 while(<SOCKET>) 66 { 67 chomp(); 68 @args = split(' ', "$_"); 69 if (substr($args[0], 0, 1) eq ":") 70 { 71 if ($args[1] eq "433") 72 { 73 print SOCKET "nick $nick2\nlusers\n"; 74 } 75 elsif ($args[1] eq "251") 76 { 77 $tc = $args[5] + $args[8]; 78 $ns = $args[11]; 79 } 80 elsif ($args[1] eq "254") 81 { 82 $nc = $args[3]; 83 } 84 elsif ($args[1] eq "255") 85 { 86 $lc = $args[5]; 87 last; 88 } 89 } 90 } 91 close(SOCKET); 92 return ($lc, $tc, $ns, $nc); 93} 94