src/Modules/Kernel.pl

   1 #
   2 # Kernel.pl: Frontend to linux.kernel.org.
   3 #    Author: dms
   4 #   Version: v0.3 (19990919).
   5 #   Created: 19990729
   6 #
   7
   8 package Kernel;
   9
  10 use IO::Socket;
  11 use strict;
  12
  13 ### TODO: change this to http instead of finger?
  14 my $server      = "ftp.kernel.org";
  15 my $port        =  79;
  16 my $proto       = getprotobyname('tcp');
  17
  18 ###local $SIG{ALRM} = sub { die "alarm\n" };
  19
  20 sub kernelGetInfo {
  21 ###    return unless &main::loadPerlModule("IO::Socket");
  22
  23     my $socket    = new IO::Socket;
  24
  25     socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
  26     eval {
  27         alarm 15;
  28         connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
  29         alarm 0;
  30     };
  31
  32     my @retval;
  33
  34     if ($@ && $@ ne "alarm\n") {                # failed.
  35         return;
  36     }
  37
  38     $socket->autoflush(1);      # required.
  39
  40     print $socket "\n";
  41     while (<$socket>) {
  42         chop;
  43
  44         s/\t//g;
  45         s/\s$//;
  46         s/\s+/ /g;
  47
  48         next if ($_ eq "");
  49
  50         push(@retval, $_);
  51     }
  52     close $socket;
  53
  54     @retval;
  55 }
  56
  57 sub Kernel {
  58     my @now = &kernelGetInfo();
  59     if (!scalar @now) {
  60         &main::msg($main::who, "failed.");
  61         return;
  62     }
  63
  64     foreach (@now) {
  65         &main::msg($main::who, $_);
  66     }
  67 }
  68
  69 sub kernelAnnounce {
  70     my $file = "$main::infobot_base_dir/Temp/kernel.txt";
  71     my @now  = &kernelGetInfo();
  72     my @old;
  73
  74     if (!scalar @now) {
  75         &main::DEBUG("kA: failure to retrieve.");
  76         return;
  77     }
  78
  79     if (! -f $file) {
  80         open(OUT, ">$file");
  81         foreach (@now) {
  82             print OUT "$_\n";
  83         }
  84         close OUT;
  85
  86         return;
  87     } else {
  88         open(IN, $file);
  89         while (<IN>) {
  90             chop;
  91             push(@old,$_);
  92         }
  93         close IN;
  94     }
  95
  96     my @new;
  97     for(my $i=0; $i<scalar(@old); $i++) {
  98         next if ($old[$i] eq $now[$i]);
  99         push(@new, $now[$i]);
 100     }
 101
 102     if (scalar @now != scalar @old) {
 103         &main::DEBUG("kA: scalar mismatch; removing and exiting.");
 104         unlink $file;
 105         return;
 106     }
 107
 108     if (!scalar @new) {
 109         &main::DEBUG("kA: no new kernels.");
 110         return;
 111     }
 112
 113     my $chan;
 114     my @chans = split(/[\s\t]+/, lc $main::param{'kernelAnnounce'});
 115     @chans    = keys(%main::channels) unless (scalar @chans);
 116     foreach $chan (@chans) {
 117         next unless (&main::validChan($chan));
 118
 119         &main::status("sending kernel update to $chan.");
 120         foreach (@new) {
 121             &main::notice($chan, "Kernel: $_");
 122         }
 123     }
 124
 125     open(OUT, ">$file");
 126     foreach (@now) {
 127         print OUT "$_\n";
 128     }
 129     close OUT;
 130 }
 131
 132 1;