home *** CD-ROM | disk | FTP | other *** search
/ Internet Toolkit / Internet Toolkit.iso / info / lumberja < prev    next >
Encoding:
Text File  |  1993-04-05  |  12.1 KB  |  489 lines
  1. #! /bin/sh
  2. # This is a shell archive.  Remove anything before this line, then unpack
  3. # it by saving it into a file and typing "sh file". To overwrite existing
  4. # files, type "sh file -c".  You can also feed this as standard input via
  5. # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
  6. # will see the following message at the end:
  7. #        "End of shell archive."
  8. # Contents:  ircclient.pl lumberjak
  9. # Wrapped by hrose@eff on Wed Sep  4 16:37:53 1991
  10. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  11. if test -f ircclient.pl -a "${1}" != "-c" ; then 
  12.   echo shar: Will not over-write existing file \"ircclient.pl\"
  13. else
  14. echo shar: Extracting \"ircclient.pl\" \(4692 characters\)
  15. sed "s/^X//" >ircclient.pl <<'END_OF_ircclient.pl'
  16. X#!/guest/ckd/bin.sun4/perl -- # -*-Perl-*-
  17. X
  18. Xrequire 'sys/socket.ph';
  19. X
  20. Xpackage ircclient;
  21. X
  22. X# the basics for making CLIENT connections to an irc socket
  23. X# *NOT* a parser, just the sending code.  Parsers are easy.
  24. X
  25. Xsub bindsocket {        # bind a socket
  26. X    local($sockname,$target,$port) = @_;
  27. X    local($sockaddr,$name,$aliases,$proto,$type,$len,
  28. X      $thisaddr,$thataddr,$this,$that,$savfh,$hostname);
  29. X        
  30. X    $sockaddr = 'S n a4 x8';
  31. X    chop($hostname = `hostname`);
  32. X    $sockname =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
  33. X    
  34. X    ($name, $aliases, $proto) = getprotobyname('tcp');
  35. X    ($name, $aliases, $port) = getservbyname($port, 'tcp')
  36. X    unless $port =~ /^\d+$/;;
  37. X    ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  38. X    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($target);
  39. X    
  40. X    $this = pack($sockaddr, &main'AF_INET, 0, $thisaddr);
  41. X    $that = pack($sockaddr, &main'AF_INET, $port, $thataddr);
  42. X    
  43. X    socket($sockname, &main'PF_INET, &main'SOCK_STREAM, $proto) ||
  44. X    die "socket $sockname: $!";
  45. X    bind($sockname, $this) || die "bind $sockname: $!";
  46. X    connect($sockname, $that) || die "connect $sockname: $!";
  47. X    $savfh = select($sockname); $| = 1; select($savfh);
  48. X    $socket = $sockname;
  49. X}
  50. X
  51. Xsub admin {
  52. X    local($target) = @_;
  53. X
  54. X    send($socket,"ADMIN $target\n",0);
  55. X}
  56. X
  57. Xsub away {
  58. X    local($message) = @_;
  59. X    $message = " :$message" if $message;
  60. X    send($socket,"AWAY$message\n",0);
  61. X}
  62. X
  63. Xsub channel {
  64. X    local($channel) = @_;
  65. X
  66. X    send($socket,"CHANNEL $channel\n",0);
  67. X}
  68. X
  69. Xsub connect {
  70. X    local($toserver, $port, $fromserver) = @_;
  71. X
  72. X    send($socket, "CONNECT $toserver $port $fromserver\n",0);
  73. X}
  74. X
  75. X
  76. Xsub deoper {
  77. X    send($socket, "DEOPER\n",0);
  78. X}
  79. X
  80. Xsub die {
  81. X    send($socket, "DIE\n",0);
  82. X}
  83. X
  84. Xsub info {
  85. X    local($target) = @_;
  86. X
  87. X    send($socket,"INFO $target\n",0);
  88. X}
  89. X
  90. Xsub invite {
  91. X    local($target,$channel) = @_;
  92. X    send($socket, "INVITE $target $channel\n",0);
  93. X}
  94. X
  95. Xsub join {
  96. X    local($channel) = @_;
  97. X    send($socket, "JOIN $channel\n",0);
  98. X}
  99. X
  100. Xsub kick {
  101. X    local($channel,$target) = @_;
  102. X    send($socket, "KICK $channel $target\n",0);
  103. X}
  104. X
  105. Xsub kill {
  106. X    local($target,$comment) = @_;
  107. X    send($socket, "KILL $target $comment\n",0);
  108. X}
  109. X
  110. Xsub links {
  111. X    local($mask) = @_;
  112. X    send($socket, "LINKS $mask\n",0);
  113. X}
  114. X
  115. Xsub list {
  116. X    local($channel) = @_;
  117. X    send($socket, "LIST $channel\n",0);
  118. X}
  119. X
  120. Xsub lusers {
  121. X    send($socket, "LUSERS\n",0);
  122. X}
  123. X
  124. Xsub mode {
  125. X    local($channel,$mode) = @_;
  126. X    send($socket, "MODE $channel $mode\n",0);
  127. X}
  128. X
  129. Xsub motd {
  130. X    local($target) = @_;
  131. X
  132. X    send($socket, "MOTD $target\n",0);
  133. X}
  134. X
  135. Xsub msg {
  136. X    local(@strings)=@_;
  137. X    foreach(@strings){
  138. X    send($socket,"MSG :$_\n",0);
  139. X    }
  140. X}
  141. X
  142. Xsub names {
  143. X    local($channel) = @_;
  144. X    send($socket, "NAMES $channel\n",0);
  145. X}
  146. X
  147. Xsub nick {
  148. X    local($target)=@_;
  149. X    send($socket, "${srcstring}NICK $target\n",0);
  150. X}
  151. X
  152. Xsub notice {
  153. X    local($target,@strings)=@_;
  154. X    foreach(@strings){
  155. X    send($socket,"NOTICE $target :$_\n",0);
  156. X    }
  157. X}
  158. X
  159. Xsub oper {
  160. X    local($name,$passwd) = @_;
  161. X
  162. X    send($socket,"OPER $name $passwd\n",0);
  163. X}
  164. X
  165. Xsub part {
  166. X    local($channel)=@_;
  167. X    send($socket, "PART $channel\n",0);
  168. X}
  169. X
  170. Xsub pong {
  171. X    local($target)=@_;
  172. X    send($socket, "PONG $target\n",0);
  173. X}
  174. X
  175. Xsub privmsg {
  176. X    local($target,@strings)=@_;
  177. X    foreach(@strings){
  178. X    send($socket,"PRIVMSG $target :$_\n",0);
  179. X    }
  180. X}
  181. X
  182. Xsub quit {
  183. X    send($socket, "QUIT\n",0);
  184. X}
  185. X
  186. Xsub quote {
  187. X    send($socket,"@_\n", 0);
  188. X}
  189. X
  190. Xsub squit {
  191. X    local($target)=@_;
  192. X    send($socket, "SQUIT $target\n",0);
  193. X}
  194. X
  195. Xsub stats {
  196. X    local($target,$flags)=@_;
  197. X    send($socket, "STATS $flags $target\n",0);
  198. X}
  199. X
  200. Xsub summon {
  201. X    local($target) = @_;
  202. X
  203. X    send($socket, "SUMMON $target\n",0);
  204. X}
  205. X
  206. Xsub time {
  207. X    local($target) = @_;
  208. X
  209. X    send($socket, "TIME $target\n",0);
  210. X}
  211. X
  212. Xsub topic {
  213. X    local($string)=@_;
  214. X    send($socket, "TOPIC $string\n",0);
  215. X}
  216. X
  217. Xsub trace {
  218. X    local($target)=@_;
  219. X    send($socket, "TRACE $target\n",0);
  220. X}
  221. X
  222. Xsub user {
  223. X    local($username,$machine,$server,$fullname)=@_;
  224. X    send($socket, "USER $username $machine $server $fullname\n",0);
  225. X}
  226. X
  227. Xsub users {
  228. X    local($target)=@_;
  229. X    send($socket, "USERS $target\n",0);
  230. X}
  231. Xsub version {
  232. X    local($target)=@_;
  233. X    send($socket, "VERSION $target\n",0);
  234. X}
  235. X
  236. Xsub voice {
  237. X    local($target,$string)=@_;
  238. X    send($socket,"VOICE $target :$string\n",0);
  239. X}
  240. X
  241. Xsub wall {
  242. X    local($string)=@_;
  243. X    send($socket,"WALL $string\n",0);
  244. X}
  245. X
  246. Xsub wallops {
  247. X    local($string)=@_;
  248. X    send($socket,"WALLOPS $string\n",0);
  249. X}
  250. X
  251. Xsub who {
  252. X    local($mask) = @_;
  253. X    send($socket,"WHO $mask\n",0);
  254. X}
  255. X
  256. Xsub whois {
  257. X    local($mask) = @_;
  258. X    send($socket,"WHOIS $mask\n",0);
  259. X}
  260. X
  261. Xsub whowas {
  262. X    local($mask) = @_;
  263. X    send($socket,"WHOWAS $mask\n",0);
  264. X}
  265. X
  266. X1;                # so require works right.
  267. END_OF_ircclient.pl
  268. if test 4692 -ne `wc -c <ircclient.pl`; then
  269.     echo shar: \"ircclient.pl\" unpacked with wrong size!
  270. fi
  271. # end of overwriting check
  272. fi
  273. if test -f lumberjak -a "${1}" != "-c" ; then 
  274.   echo shar: Will not over-write existing file \"lumberjak\"
  275. else
  276. echo shar: Extracting \"lumberjak\" \(5887 characters\)
  277. sed "s/^X//" >lumberjak <<'END_OF_lumberjak'
  278. X#!/usr/bin/perl -- # -*-Perl-*-
  279. X
  280. X# local defines
  281. X$OPERPASSFILE = '/other/irc/lib/robot.pw';
  282. X
  283. X# variables:
  284. X#    $port, $server    - server to connect to
  285. X#    $servername       - name of the server we're on
  286. X#                        (what the server calls itself)
  287. X#    $nick             - nickname
  288. X#    $fullname         - full name field
  289. X#    $username         - username to use with server
  290. X#    S                 - socket file handle
  291. X#    $source           - source of a remote message
  292. X#    $quitflag         - set to 1 to quit
  293. X#    $lord             - my lord and liege
  294. X#    $magicword        - how do you make me leave?
  295. X#    $eavesdrop        - forward MSGs to lord
  296. X#    $biff             - REALLY COOL MODE DOOD
  297. X#    $verbose          - debugging mode
  298. X#    $talk             - like stuff a lot
  299. X#    $greet            - say hi to people
  300. X#    %lastpriv         - last msg from whoever
  301. X
  302. X# primitive support functions
  303. X
  304. Xsub Upcase {            # upcase the arg & return it
  305. X    local($string) =@_;
  306. X    $string =~ tr/a-z/A-Z/;
  307. X    $string;
  308. X}
  309. X
  310. Xsub StripLeadingColon {        # strips the leading colon if any from $arg
  311. X    local($string) = @_;    # and returns the str without the :
  312. X    $string =~ s/^://;        # (written because IRC has so many :msgs)
  313. X    $string;
  314. X}
  315. X# cmdline parsing now uses getopt.pl for ease of expansion
  316. X$| = 1;                # allow for debug messages
  317. X
  318. Xpush(@INC,'/home/ckd/lib/perl');
  319. X
  320. Xrequire 'getopts.pl';
  321. Xrequire 'ircclient.pl';
  322. Xrequire 'ctime.pl';
  323. X
  324. Xdo Getopts('p:s:n:f:u:l:c:d:o');
  325. X# port, server, nick, fullname, username, lord, channel, magicword, dumpfile
  326. X# Booleans: o = oper, e = eavesdrop, v = verbose-debug, b = biff, t = talk,
  327. X# g = greet, r= revenger
  328. X
  329. X$port = $opt_p || $ENV{'IRCPORT'} || 6667;
  330. X$server = $opt_s || $ENV{'IRCSERVER'} || 'eff.org';
  331. X$nick = $opt_n || $ENV{'IRCAUTONICK'} || 'LumberJak';
  332. X$fullname = $opt_f || $ENV{'IRCAUTONAME'} || 'I log all night and I log all day';
  333. X$username = $opt_u || getlogin || (getpwuid($<))[0];
  334. X$lord = $opt_l || $ENV{'IRCNICK'} || $ENV{'USER'} || (getpwuid($<))[0] ||
  335. X    die "The death of God left the angels in a strange position";
  336. X$channel = $opt_c || "#Twilight_Zone";
  337. X#$magicword = $opt_m || 'Bernstein';
  338. X$delay = 1;
  339. X$dumpfile =  $opt_d || '/home/hrose/trillian/ircstuff/bot.dumplog';
  340. X
  341. X#$eavesdrop = $opt_e; $debug = $opt_v; $biff = $opt_b;
  342. X#$talk = $opt_t; $greet = $opt_g; $vengeance = $opt_r;
  343. X
  344. X
  345. Xchop($operpass = `head -1 $OPERPASSFILE`);
  346. X
  347. X
  348. Xopen(LOGFILE,">>$dumpfile");
  349. Xselect ((select (LOGFILE),$|=1)[0]);
  350. X&ircclient'bindsocket('S',$server,$port);
  351. X
  352. X# now we have a socket connected to the server, time to play
  353. X
  354. X# first, signon as a client
  355. X&ircclient'nick($nick);
  356. X&ircclient'user($username,$username,$server,$fullname);
  357. Xif ($operpass) {
  358. X    &ircclient'oper('robotman',$operpass);
  359. X}
  360. X
  361. X&ircclient'join($channel);
  362. X
  363. X# next, completely ignore the message of the day
  364. X# while getting the server's name for itself
  365. X
  366. X munchmotd:
  367. X    while (<S>) {
  368. X    chop;
  369. X    ($servername) = m/.*Your host is ([^ ,]+),.*/
  370. X        if m/Your host is/;
  371. X    if (( m!End of /MOTD command! ) ||
  372. X        ( m!Message-of-today is missing! )) {
  373. X        last munchmotd;
  374. X    }
  375. X    }
  376. X
  377. X$servername = $server unless $servername; # do some simple trapping for oldies
  378. X
  379. X mainloop: while (<S>) {
  380. X     chop;
  381. X     $_ = ":$servername $_" unless /^:/;
  382. X     ($source, $command, $parms) = split(/ /,$_,3);
  383. X     $source = &StripLeadingColon($source);
  384. X     $cmd = &Upcase($command);
  385. X   cmdcase:            # treated as a switch/case type thingy
  386. X     {            # as long as you're careful about eq
  387. X     if ($cmd eq 'CHANNEL') {&ParseChan($source,$cmd,$parms);
  388. X                 last cmdcase;};
  389. X     if ($cmd eq 'JOIN') {&ParseChan($source,$cmd,$parms);
  390. X                  last cmdcase;};
  391. X     if ($cmd eq 'PART') {&ParseChan($source,$cmd,$parms);
  392. X                  last cmdcase;};
  393. X     if ($cmd eq 'INVITE') {&ParseInvite($source,$parms);
  394. X                last cmdcase;};
  395. X     if ($cmd eq 'MSG') {&ParseMsg($source,$parms);
  396. X                 last cmdcase;};
  397. X     if ($cmd eq 'NOTICE') {&ParseNotice($source,$parms);
  398. X                last cmdcase;};
  399. X     if ($cmd eq 'PING') {&ircclient'pong($nick);
  400. X                  last cmdcase;};
  401. X     if ($cmd eq 'PRIVMSG') {&ParsePriv($source,$parms);
  402. X                 last cmdcase;};
  403. X     if ($cmd eq 'WALLOPS') {&ParseWallops($source,$parms);
  404. X                 last cmdcase;};
  405. X     if ($cmd eq 'WALL') {&ParseWall($source,$parms);
  406. X                  last cmdcase;};
  407. X     if ($cmd eq 'QUIT') {&ParseQuit($source,$parms);
  408. X                  last cmdcase;};
  409. X     if ($cmd eq 'NAMREPLY') {&ParseNamReply($source,$parms);
  410. X                  last cmdcase;};
  411. X     }        
  412. X     
  413. X } continue {
  414. X     if ($quitflag)
  415. X     {&Quit;}
  416. X}
  417. X
  418. X# nifty parse stuff
  419. Xsub ParseChan {
  420. X    local ($who, $cmd, $chan)= @_;
  421. X#    print LOGFILE "$who ${cmd}ed $chan\n";
  422. X    print LOGFILE "$who ${cmd}ed $chan at ",&ctime(time);    
  423. X}
  424. Xsub ParseInvite {
  425. X    local ($who, $args) = @_;
  426. X    print LOGFILE "$who invited me to $args\n";
  427. X    &ircclient'notice($who,"Sorry, I'd rather stay here.");
  428. X}
  429. X
  430. Xsub ParsePriv {
  431. X    local($src,$args) = @_;
  432. X    
  433. X    local($target,$message) = split(/ /,$args,2);
  434. X
  435. X    $target = "me" if $target =~ /$nick/i;
  436. X    $message = &StripLeadingColon($message);
  437. X    
  438. X    print LOGFILE "$src told $target \"$message\".\n";
  439. X    
  440. X}
  441. X
  442. Xsub ParseNamReply {
  443. X    local ($src,$args) = @_;
  444. X    print LOGFILE "NAMREPLY = $args\n";
  445. X}
  446. X
  447. Xsub ParseNotice {
  448. X    local ($src,$args) = @_;
  449. X    local($target,$message) = split(/ /,$args,2);
  450. X
  451. X    $target = "me" if $target =~ /$nick/i;
  452. X    $message = &StripLeadingColon($message);
  453. X    
  454. X    print LOGFILE "$src NOTICEd $target \"$message\".\n";
  455. X}
  456. Xsub ParseChanMsg {
  457. X    local($src,$target,$message) = @_;
  458. X    print LOGFILE "$src told $target \"$message\".\n";
  459. X}
  460. X
  461. Xsub ParseWallops {
  462. X    local ($src,$args) = @_;
  463. X    print LOGFILE "$src walloped $args at ",&ctime(time);
  464. X}
  465. X
  466. Xsub ParseWall {
  467. X    local ($src,$args) = @_;
  468. X    print LOGFILE "$src WALLed $args\n";
  469. X}
  470. X
  471. Xsub ParseQuit {
  472. X    local ($src,$args) = @_;
  473. X    print LOGFILE "$src QUIT at ",&ctime(time);
  474. X}
  475. X
  476. Xsub Quit {
  477. X    &ircclient'privmsg($lord,"Hey, man, I'm outa here.");
  478. X    &ircclient'quit;
  479. X}
  480. END_OF_lumberjak
  481. if test 5887 -ne `wc -c <lumberjak`; then
  482.     echo shar: \"lumberjak\" unpacked with wrong size!
  483. fi
  484. chmod +x lumberjak
  485. # end of overwriting check
  486. fi
  487. echo shar: End of shell archive.
  488. exit 0
  489.