apps/irssi/scripts/silc-mime.pl

   1 #!/usr/bin/perl
   2
   3 use vars qw($VERSION %IRSSI);
   4
   5 use Irssi 20020704;
   6 $VERSION = "1.0";
   7 %IRSSI = (
   8     authors     => "Jochen 'c0ffee' Eisinger",
   9     contact     => "c0ffee\@penguin-breeder.org",
  10     name        => "SILC2 MIME handler",
  11     description => "This script implements MIME handlers for SILC2, according to draft-riikonen-silc-flags-payloads-00, RFC 822, 1525, 2046, 2733, 2822, 3009",
  12     license     => "GPL2 or any later",
  13     url         => "http://www.penguin-breeder.org/silc/",
  14     changed     => "Sun Aug 24 17:52 CEST 2003",
  15 );
  16
  17 use MIME::Parser;
  18 use Mail::Field;
  19 use Mail::Cap;
  20 use IO::Scalar;
  21 use IO::File;
  22 use File::Temp qw/ :POSIX /;
  23 use Sys::Hostname;
  24
  25 my @mcaps;
  26
  27 ##
  28 # read_mime_database
  29 #
  30 # Loads all mailcap databases specified in the setting
  31 # mime_database.  Default is ~/.mailcap and /etc/mailcap in
  32 # that order.  Function is invoked on startup.
  33 sub read_mime_database {
  34     # read mailcap databases rfc1525
  35     foreach (split /\s+/, Irssi::settings_get_str("mime_database")) {
  36         if (( -f $_ ) and ( -R $_ )) {
  37             Irssi::printformat(MSGLEVEL_CRAP, 'load_mailcap', $_);
  38             $mcap = new Mail::Cap $_;
  39             push @mcaps, $mcap;
  40         } else {
  41             Irssi::printformat(MSGLEVEL_CRAP, 'load_mailcap_fail', $_);
  42         }
  43     }
  44 }
  45
  46 ##
  47 # unescape
  48 #
  49 # Removes the null-byte escaping from a data block.  Returns the
  50 # unescaped data.  All data send via mime signals must be escaped.
  51 sub unescape {
  52     my ($escaped) = @_;
  53     $escaped =~ s/\001\001/\000/g;
  54     $escaped =~ s/\001\002/\001/g;
  55
  56     return $escaped;
  57 }
  58
  59 ##
  60 # escape
  61 #
  62 # Escapes null-bytes for signal transfer.  Used to transfer binary data
  63 # in null-terminated strings.  Returns the escaped data.  All data send
  64 # via mime signals must be escaped.
  65 sub escape {
  66     my ($unescaped) = @_;
  67     $unescaped =~ s/\001/\001\002/g;
  68     $unescaped =~ s/\000/\001\001/g;
  69
  70     return $unescaped;
  71 }
  72
  73 my %partial;
  74
  75 ##
  76 # process_mime_entity(MIME::Entity $msg)
  77 #
  78 # -1 failure, 0 success
  79 sub process_mime_entity {
  80   my ($entity) = @_;
  81
  82   $mimetype = Mail::Field->new('Content-type', $entity->head->get('Content-Type'));
  83
  84   # check whether this is message/partial
  85   if ($mimetype->type eq  "message/partial") {
  86
  87     # without an ID i don't know what stream this is related to
  88     if ($mimetype->id eq "") {
  89       Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "no ID");
  90       return -1;
  91     }
  92
  93     # the first packet is treated seperatly
  94     if ($mimetype->number == 1) {
  95
  96       # the IDs should be unique
  97       if (defined $partial{$mimetype->id}) {
  98         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "duplicate ID");
  99         $fh = $partial{$mimetype->id}{file};
 100         $fh->close;
 101         unlink $partial{$mimetype->id}{name};
 102         undef $partial{$mimetype->id};
 103         return -1;
 104       }
 105
 106       # create a new record
 107       $partial{$mimetype->id}{received} = 1;
 108       $partial{$mimetype->id}{name} = tmpnam();
 109       $fh = new IO::File "> $partial{$mimetype->id}{name}";
 110       $partial{$mimetype->id}{file} = $fh;
 111       $partial{$mimetype->id}{count} = 1;
 112       $partial{$mimetype->id}{total} = $mimetype->total;
 113
 114     } else { # 2nd and later packets
 115
 116       # detect unknown IDs
 117       if (not defined $partial{$mimetype->id}) {
 118         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "unknown ID");
 119         return -1;
 120       }
 121
 122       # the 'total' information can be set in any packet,
 123       # however it has to be the same all the time
 124       if ($mimetype->total > 0) {
 125
 126         if (($partial{$mimetype->id}{total} > 0) &&
 127             ($partial{$mimetype->id}{total} != $mimetype->total)) {
 128           Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "invalid count");
 129           $fh = $partial{$mimetype->id}{file};
 130           $fh->close;
 131           unlink $partial{$mimetype->id}{name};
 132           undef $partial{$mimetype->id};
 133           return -1;
 134         }
 135
 136         $partial{$mimetype->id}{total} = $mimetype->total;
 137
 138       }
 139
 140       # we expect to receive packets in order
 141       if ($mimetype->number != ($partial{$mimetype->id}{count} + 1)) {
 142         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "invalid sequence number");
 143         $fh = $partial{$mimetype->id}{file};
 144         $fh->close;
 145         unlink $partial{$mimetype->id}{name};
 146         undef $partial{$mimetype->id};
 147         return -1;
 148       }
 149
 150       # update our sequence record and save the packet
 151       $partial{$mimetype->id}{count} = $mimetype->number;
 152
 153     }
 154
 155     # and save the packet
 156     $fh = $partial{$mimetype->id}{file};
 157     if ($io = $entity->bodyhandle->open("r")) {
 158       while (defined($_ = $io->getline)) { print $fh $_ }
 159       $io->close;
 160     }
 161
 162     # return if this wasn't the last packet
 163     if (($partial{$mimetype->id}{total} == 0) ||
 164         ($partial{$mimetype->id}{count} < $partial{$mimetype->id}{total})) {
 165       return 1;
 166     }
 167
 168     # last packet...
 169     $tempfile = $partial{$mimetype->id}{name};
 170     $fh = $partial{$mimetype->id}{file};
 171     $fh->close;
 172     undef $partial{$mimetype->id};
 173
 174     $parser = new MIME::Parser;
 175     $parser->output_dir("/tmp");
 176     $mime = $parser->parse_open($tempfile);
 177
 178     $ret = process_mime_entity($mime);
 179
 180     $parser->filer->purge;
 181     unlink $tempfile;
 182     return $ret;
 183
 184   }
 185
 186   # we could check for */parityfec (RTP packets) rfc2733, 3009
 187
 188   # save to temporary file
 189   $tempfile = tmpnam();
 190   open TFILE, '>', $tempfile;
 191   if ($io = $entity->open("r")) {
 192     while (defined($_ = $io->getline)) { print TFILE $_; }
 193     $io->close;
 194   }
 195   close TFILE;
 196
 197   # try to handle it
 198   foreach $mcap (@mcaps) {
 199     $mcap->view($mimetype->type, $tempfile);
 200
 201     next if not $?;
 202     unlink $tempfile if Irssi::settings_get_bool("mime_unlink_tempfiles");
 203     return 1;
 204   }
 205
 206   unlink $tempfile if Irssi::settings_get_bool("mime_unlink_tempfiles");
 207   return $mimetype->type;
 208 }
 209
 210 ##
 211 # sig_mime
 212 #
 213 # signal handler for incoming MIME type messages.  If the encoding or
 214 # the content type are missing or not parsable, they default to binary
 215 # and application/octet-stream respectivly.  If a decoder for the given
 216 # transfer encoding is available, the message is decoded.  If a handler
 217 # for the given content type is available in one of the mailcap databases,
 218 # the handler is invoked and the signal is stopped.  The mailcap databases
 219 # are scanned in order of loading.  Temporary files are unlinked if the
 220 # setting mime_unlink_tempfiles is true.
 221 sub sig_mime {
 222
 223     my ($server, $witem, $blob, $sender, $verified) = @_;
 224
 225     $parser = new MIME::Parser;
 226     $parser->output_dir("/tmp");
 227     $mime = $parser->parse_data(unescape($blob));
 228
 229     $ret = process_mime_entity($mime);
 230
 231     $parser->filer->purge;
 232
 233     if ($ret == 1) {
 234       Irssi::signal_stop();
 235     } elsif  ($ret == -1) {
 236       return;
 237     } else {
 238       Irssi::print "Unknown MIME type $ret received...";
 239     }
 240 }
 241
 242 ##
 243 # cmd_mmsg
 244 #
 245 # Sends a file with a given MIME type and transfer encoding.
 246 #
 247 # MMSG [<-channel>] <target> <file> [<content-type>  [<transfer-encoding>]]
 248 #
 249 # Sends a private data message to other user in the network.  The message
 250 # will be send as a MIME encoded data message.
 251 #
 252 # If -channel option is provided then this command actually send channel
 253 # message to the specified channel.  The message IS NOT private message, it
 254 # is normal channel message.
 255 #
 256 # Messages that exceed roughly 64k have to be split up into smaller packets.
 257 # This is done automatically.
 258 #
 259 # If no transfer-encoding is given it defaults to binary or 7bit for messages
 260 # that have to be split up.
 261 #
 262 # If no content-type is given it defaults to application/octet-stream.
 263 #
 264 # Examples
 265 #
 266 # /MMSG Foobar smiley.gif image/gif binary
 267 # /MMSG -channel silc silc.patch text/x-patch 7bit
 268 # /MMSG * boing.mp3 audio/mpeg
 269 sub cmd_mmsg {
 270     my ($data, $server, $witem) = @_;
 271
 272     if ($server->{chat_type} ne "SILC") {
 273         Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_chattype');
 274         return;
 275     }
 276
 277     ($is_channel, $target, $file, $type, $encoding) =
 278         $data =~ /^\s*(?:(-channel)?\s+)? # match the -channel
 279                   (\*|\S+)\s+             # target
 280                   (\S+)                   # filename
 281                   (?:\s+(\S+)             # mime type
 282                      (?:\s+(\S+))?)?\s*   # encoding
 283                  $/ix;
 284
 285     Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_parameters'), return
 286         if ($target eq "") or ($file eq "");
 287
 288     Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_file', $file), return
 289         if not ( -f $file );
 290
 291     $type = Irssi::settings_get_str("mime_default_type")
 292         if not defined $type;
 293     $encoding = Irssi::settings_get_str("mime_default_encoding")
 294         if not defined $encoding;
 295
 296     # does the target exist? we don't test that... especially the
 297     # -channel parameter is ignored :/
 298
 299     # XXX
 300     $to = $witem;
 301
 302     $entity = new MIME::Entity->build(
 303         'MIME-Version' => "1.0",
 304         Encoding       => $encoding,
 305         Type           => $type,
 306         Path           => $file
 307     );
 308
 309     $tempfile = tmpnam();
 310     open TFILE, '>', $tempfile;
 311     $entity->print(\*TFILE);
 312     close TFILE;
 313
 314
 315     # 21:27 <@pekka> c0ffee: the core routines will crop the message if it
 316     #                doesn't fit.. I would use a bit shorter than the MAX_LEN
 317     # 21:28 <@pekka> c0ffee: -1024 bytes is sufficient
 318     # 21:28 <@pekka> c0ffee: should be sufficient in all possible cases
 319     if ((stat($tempfile))[7] < 0xfbff) {
 320
 321       unlink $tempfile;
 322       Irssi::signal_emit("mime-send", $server, $to, escape($entity->stringify), 0);
 323     } else {
 324
 325       open TFILE, $tempfile;
 326       $id = sprintf "id-%06d-%08d\@%s", int(rand(65535)), time(), hostname();;
 327       $chunks = 0;
 328       do {
 329         read TFILE, $data, 0xfb00;
 330         $chunks++;
 331
 332         $entity = new MIME::Entity->build(
 333             'MIME-Version' => "1.0",
 334             Encoding       => "binary",
 335             Type           => "message/partial; id=\"$id\"; number=$chunks" .
 336                                 (eof(TFILE) ? "; total=$chunks" : ""),
 337             Data           => $data
 338         );
 339         Irssi::signal_emit("mime-send", $server, $to, escape($entity->stringify), 0);
 340
 341     } while (!eof(TFILE));
 342     close TFILE;
 343
 344     unlink $tempfile;
 345   }
 346 }
 347
 348 # Signal handlers
 349 Irssi::signal_add("mime", "sig_mime");
 350
 351 # Commands
 352 Irssi::command_bind("mmsg", "cmd_mmsg");
 353
 354 # Settings
 355 Irssi::settings_add_str("misc", "mime_database",
 356     "$ENV{HOME}/.mailcap /etc/mailcap");
 357 Irssi::settings_add_bool("misc", "mime_unlink_tempfiles", 0);
 358 Irssi::settings_add_str("misc", "mime_default_type", "application/octet-stream");
 359 Irssi::settings_add_str("misc", "mime_default_encoding", "binary");
 360
 361 # Init
 362 Irssi::theme_register(['load_mailcap', 'Loading mailcaps from {hilight $0}',
 363         'load_mailcap_fail', 'Couldn\'t find {hilight $0}',
 364         'message_partial_failure', 'message/partial: {hilight $0-}',
 365         'mmsg_chattype', 'command was not designed for this chat type',
 366         'mmsg_parameters', 'not enough parameters given',
 367         'mmsg_file', 'File {hilight $0} not found']);
 368
 369 read_mime_database();