Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

ircpipe

by iblech (Friar)
on Aug 18, 2004 at 17:39 UTC ( [id://384049]=sourcecode: print w/replies, xml ) Need Help??
Category: Networking Code
Author/Contact Info Ingo Blechschmidt, iblech@web.de
Description: ircpipe allows simple shellscripts to send messages over IRC.

ircpipe consists of two parts, a daemon and a client. A FIFO is used for IPC:
mkfifo ~/.ircpipe.fifo

Then, start the daemon:
ircpiped --fifo=$HOME/.ircpipe.fifo -v

Now you can use ircpipe to send something:
date | ircpipe --server=thestars --to=iblech
date | ircpipe --server=thestars --to=#bots

The server will connect to the given server and join the given channel if necessary.
Connections are kept alive.
ircpipe will return immediately after notifying the daemon, i.e. it does not wait for the message to be delivered.
If you send too long lines for IRC, they get word-wrapped.

Note: ircpipe depends on POE::Component::IRC::Tracking, which can be found here.
Note: ircpipe does not work on Win32, because ircpipe depends on FIFOs.
For your convenice, all necessary files are packaged at http://m19s28.vlinux.de/iblech/ircpipe.tbz2.

Update: ircpiped didn't correctly detect if it's logged in. Fixed.
##########[ ircpipe starts here  ]##########
#!/usr/bin/perl

use warnings;
use strict;

use Fcntl qw( :DEFAULT :flock );
use Getopt::Long;

# The FIFO ircpiped listens on.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my ($server, $to);
my $help;

my $ok = GetOptions(
  "fifo=s"   => \$fifo,
  "server=s" => \$server,
  "to=s"     => \$to,
  "help"     => \$help
);

if(!$ok or !$server or !$to or $help) {
  print STDERR <<USAGE;
ircpipe -- Trigger ircpiped to send a message

Usage: $0 [--fifo=~/.ircpipe.fifo] [--help] --server=host[:port] --to=
+#channel [files]

Options:
  --fifo=~/.ircpipe.fifo      Sets the FIFO ircpiped listens on.
                              Important: ircpiped has to be started
                  using the same FIFO.
  --help                      Displays this message.
  --server=host[:port]        Sets the server to connect to. port defa
+ults to
                  6667.
  --to=#channel or            Sets the recipient.
  --to=nick

Non-option arguments are taken to be filenames which should be sent. I
+f no
file's specified, ircpipe reads from STDIN.

Options may be abbreviated to uniqueness.
USAGE
  exit;
}

# Default $port to 6667.
my ($host, $port) = split /:/, $server;
$port ||= 6667;

# Open the FIFO and lock it exclusively. See perldoc -q lock.
sysopen my $fh, $fifo, O_RDWR|O_CREAT
  or die "Couldn't open $fifo: $!\n";
flock $fh, LOCK_EX
  or die "Couldn't flock $fifo: $!\n";

while(<>) {
  chomp;
  print $fh join(":", $host, $port, $to, $_) . "\n"
    or die "Couldn't write to $fifo: $!\n"
}

close $fh
  or die "Couldn't close $fifo: $!";

exit;
##########[ ircpipe ends here    ]##########
##########[ ircpiped starts here ]##########
#!/usr/bin/perl

use warnings;
use strict;

use POE   qw( Wheel::FollowTail );
use POSIX qw( strftime );
use Term::ANSIColor
      qw( color );
use Getopt::Long;

# Hash of Bot objects
my %bot;

# FIFO and nick to use.
my $fifo = "$ENV{HOME}/.ircpipe.fifo";
my $nick = "ircpipe";

# Need help?
my $help;

# Hackery: $verbose is global, so our package Bot has access to it, to
+o.
our $verbose;

my $ok = GetOptions(
  "fifo=s"  => \$fifo,
  "nick=s"  => \$nick,
  "help"    => \$help,
  "verbose" => \$verbose
);

if(!$ok or $help) {
  print STDERR <<USAGE;
ircpiped -- Daemon part of ircpipe

Usage: $0 [--fifo=~/.ircpipe.fifo] [--nick=ircpipe] [--verbose] [--hel
+p]

Options:
  --fifo=~/.ircpipe.fifo     Sets the FIFO to listen on
  --nick=ircpipe             Sets the nick to use
  --verbose                  Be verbose
  --help                     Displays this message

Options may be abbreviated to uniqueness.
USAGE
  exit;
}

POE::Session->create(
  inline_states => {
    _start => \&fifo_start,
    got    => \&fifo_got,
  },
);

POE::Kernel->run;
exit;

# Nice formatting... But only if the user set --verbose.
sub info ($) {
  printf STDERR "[%s%s%s] %s%s%s: %s%s%s\n",
    color("bold white"),
    strftime("%d.%m.%y/%H:%M:%S", localtime),
    color("reset"),
    color("bold yellow"),
    "fifo",
    color("reset"),
    color("bold magenta"),
    $_[0],
    color("reset")
    if $verbose or $_[1];
}

sub fifo_start {
  info "Listening on named pipe $fifo...";
  $_[HEAP]->{fifo} = POE::Wheel::FollowTail->new(
    Filename   => $fifo,
    InputEvent => "got",
  );
}

sub irc_start {
  # This sub fires up a Bot. Bot::new expects the hostname, portnumber
+, and
  # nickname to use as parameters. $_[0] is sth. like "thestars:6667",
+ so we've
  # to split it.
  $bot{$_[0]} = Bot->new(split(/:/, $_[0]), $nick);
}

sub fifo_got {
  my $line = $_[ARG0];

  # Example input line:
  #   thestars:6667:#channel:Hello
  $line =~ /^([^:]+):([^:]+):([^:]+):(.+)$/ or do {
    info "Malformed input line: \"$line\"";
    return;
  };
  my ($server, $to, $msg) = ("$1:$2", $3, $4);

  # Fire up a Bot if not already done.
  $bot{$server} or irc_start($server);

  # Connect to the server if not already done.
  $bot{$server}->connected or $bot{$server}->connect;

  # Join if not already joined.
  $bot{$server}->joined($to) or $bot{$server}->join($to)
    if $to =~ /^[#&+]/;

  # Send.
  $bot{$server}->privmsg($to => $msg);
}

package Bot;

use warnings;
use strict;

use POE   qw( Component::IRC::Tracking );
use POSIX qw( strftime );
use Term::ANSIColor
        qw( color );
use Text::Wrap
      qw( wrap);

# IRCNAME is the realname information shown in /WHOIS
use constant IRCNAME           => "POE::Component::IRC::Tracking power
+ed ircpipe";
# 255 is the historical line length limit. "PRIVMSG #to :" counts too,
+ so we
# say 200 and are likely safe.
use constant MAX_SEND_LEN      => 200;

# Nice formatting... But only if the user set --verbose.
sub info {
  my ($self, $msg, $force) = @_;

  printf STDERR "[%s%s%s] %s%s%s@%s%s%s: %s%s%s\n",
    color("bold white"),
    strftime("%d.%m.%y/%H:%M:%S", localtime),
    color("reset"),
    color("bold yellow"),
    $self->botheap->{nick} || "no nick",
    color("reset"),
    color("bold red"),
    $self->server,
    color("reset"),
    color("bold magenta"),
    $msg,
    color("reset")
    if $::verbose or $force;
}

sub new {
  my ($class, $host, $port, $nick) = @_;
  my $self = bless [] => $class;
  local $_;

  ($self->host, $self->port, $self->server, $self->nick) =
    ($host, $port, "$host:$port", $nick);

  # $self->perform is an arrayref of coderefs which are executed upon 
+reception
  # of 376 (End of /MOTD).
  $self->perform = [];

  $self->sid = POE::Session->create(
    object_states => [
      $self => {
        _start  => "bot_start",
        connect => "bot_connect",

    # We don't *need* those events, they're mostly only for debugging.
    map {($_)x2} qw(
      irc_connected irc_376
      irc_ctcp_ping
      irc_invite irc_474
      irc_socketerr irc_disconnected
    ),
      },
    ],
  )->ID;

  return $self;
}

# C<botheap> returns the HEAP of PoCo::IRC::Tracking
sub botheap { POE::Kernel->alias_resolve($_[0]->bot)->get_heap }

# Are we connected?
sub connected { $_[0]->botheap->{connected} and $_[0]->seen_376 }

# Are we on channel C<$_[1]>?
sub joined { $_[0]->connected and $_[0]->botheap->{channels}->{$_[1]} 
+}

# Join a channel.
sub join {
  my ($self, $chan) = @_;
  return if $self->joined($chan);

  if($self->connected) {
    # If we're connected, join.
    $self->info("Joining $chan...");
    POE::Kernel->post($self->bot, sl_login => "JOIN $chan");

  } else {
    # If not, we've to queue the join.
    # $self->perform is an arrayref of coderefs which are executed upo
+n
    # reception of 376 (End of /MOTD).
    push @{ $self->perform }, sub { $self->join($chan) };
  }
}

# Send a msg.
sub privmsg {
  my ($self, $to, $msg) = @_;

  if($self->connected) {
    # Same game as above, send immediately if we're connected, else qu
+eue.
    $self->info("Sending \"$msg\" to $to...");

    # Why local? As soon as this block is left, the original values ar
+e
    # recovered. So, if the programmer uses Text::Wrap, we don't reset
+ his
    # settings.
    local $Text::Wrap::columns = MAX_SEND_LEN;
    local $Text::Wrap::huge    = "wrap";

    # Ok, send...
    local $_;
    POE::Kernel->post($self->bot, sl_login => "PRIVMSG $to :$_")
      for split /\n/, wrap("", "", $msg);
  } else {
    # Queue.

    push @{ $self->perform }, sub { $self->privmsg($to => $msg) };
  }
}

sub bot_start {
  my $self = $_[OBJECT];

  # Fire up the bot...
  POE::Component::IRC::Tracking->new($self->bot = "bot/$self");
  # $self->bot keeps the alias of the PoCo.
  
  # ...and register all events. We don't need all, this is mainly for
  # convenience.
  POE::Kernel->post($self->bot, register => "all");
}

# This sub wraps the POE event in a nice OO method.
sub connect { POE::Kernel->post($_[0]->sid, connect => @_[1..$#_]) }

sub bot_connect {
  my $self = $_[OBJECT];

  $self->info("Connecting...");
  POE::Kernel->post($self->bot, connect => {
    Server   => $self->host,
    Port     => $self->port,
    Nick     => $self->nick,
    Username => $self->nick,
    Ircname  => IRCNAME,
  });

  # $self->seen_376 is true if we received End of /MOTD, e.g. if we're
+ inside.
  # Reset it for now.
  $self->seen_376 = 0;
}

# We get this event if the socket is successfully connected.
sub irc_connected {
  my $self = $_[OBJECT];

  $self->info("Socket connected.");
}

# 376: End of /MOTD.
# Process $self->perform.
sub irc_376 {
  my $self = $_[OBJECT];

  $self->info("Inside (got 376 event).");
  # Set $senf->seen_376 to a true value.
  $self->seen_376++;

  local $_;
  &$_ for splice @{ $self->perform };
  # splice @array returns @array and empties it.
}

# We are banned?
sub irc_474 {
  my $self = $_[OBJECT];

  my $msg = $_[ARG1];
  $msg =~ /^([^ ]+) :(.*)$/ or return;

  $self->info("Couldn't join channel $1: \"$2\"");
}

# Answer to CTCP PINGs.
sub irc_ctcp_ping {
  my $self = $_[OBJECT];

  my ($mask, undef, $ping) = @_[ARG0..$#_];
  $self->info("Got CTCP-PINGed from $mask.");

  # Don't answer to "special things" (thing without a nickname).
  $mask =~ /^([^!]+)/ or return;

  # Why don't we use PoCo::IRC's ctcp_reply here?
  # Reason: We want the PING-reply to be sent out as soon as possible.
  # PoCo::IRC's default priority of ctcp_reply is too low.
  POE::Kernel->post($self->bot, sl_login => "NOTICE $1 :\001PING $ping
+\001");
}

# Accept invitations.
sub irc_invite {
  my $self = $_[OBJECT];

  $self->info("Got invitation to $_[ARG1] from $_[ARG0].");
  $self->join($_[ARG1]);
}

# The connection got lost, notify the user.
sub irc_socketerr    { $_[0]->info("Socket error.") }
sub irc_disconnected { $_[0]->info("Connection lost.") }

sub host     : lvalue { $_[0]->[0] }
sub port     : lvalue { $_[0]->[1] }
sub server   : lvalue { $_[0]->[2] }
sub nick     : lvalue { $_[0]->[3] }
sub sid      : lvalue { $_[0]->[4] }
sub bot      : lvalue { $_[0]->[5] }
sub perform  : lvalue { $_[0]->[6] }
sub seen_376 : lvalue { $_[0]->[7] }

# That's all.

1;
#########[ ircpiped ends here   ]##########

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://384049]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2024-03-28 14:38 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found