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.1";
   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",
  12     license     => "GPL2 or any later",
  13     url         => "http://www.penguin-breeder.org/silc/",
  14     changed     => "Wed Aug 29 10:45 CET 2003",
  15 );
  16
  17 use MIME::Parser;
  18 use Mail::Field;
  19 use Mail::Cap;
  20 use File::MMagic;
  21 use IO::Scalar;
  22 use IO::File;
  23 use File::Temp qw/ tempfile /;
  24 use Sys::Hostname;
  25 use POSIX qw/ ceil /;
  26
  27 my @mcaps;
  28 my $magic = new File::MMagic;
  29
  30 ##
  31 # read_mime_database
  32 #
  33 # Loads all mailcap databases specified in the setting
  34 # mime_database.  Default is ~/.mailcap and /etc/mailcap in
  35 # that order.  Function is invoked on startup.
  36 #
  37 # MIME Magic Info is also read...
  38 sub read_mime_database {
  39     # read mailcap databases rfc1525
  40     foreach (split /\s+/, Irssi::settings_get_str("mime_database")) {
  41         if (( -f $_ ) and ( -R $_ )) {
  42             Irssi::printformat(MSGLEVEL_CRAP, 'load_mailcap', $_)
  43               if Irssi::settings_get_bool("mime_verbose");
  44             $mcap = new Mail::Cap $_;
  45             push @mcaps, $mcap;
  46         } else {
  47             Irssi::printformat(MSGLEVEL_CRAP, 'load_mailcap_fail', $_)
  48               if Irssi::settings_get_bool("mime_verbose");
  49         }
  50     }
  51
  52     $mfile = Irssi::settings_get_str("mime_magic");
  53
  54     if ($mfile ne "") {
  55         Irssi::printformat(MSGLEVEL_CRAP, 'load_mime_magic', $mfile);
  56         $magic = File::MMagic::new($mfile);
  57     }
  58
  59     if ( not -d Irssi::settings_get_str("mime_temp_dir")) {
  60
  61         Irssi::printformat(MSGLEVEL_CRAP, 'no_temp_dir',
  62             Irssi::settings_get_str("mime_temp_dir"));
  63
  64         Irssi:settings_set_str("mime_temp_dir", "/tmp");
  65
  66     }
  67 }
  68
  69 ##
  70 # unescape
  71 #
  72 # Removes the null-byte escaping from a data block.  Returns the
  73 # unescaped data.  All data send via mime signals must be escaped.
  74 sub unescape {
  75     my ($escaped) = @_;
  76     $escaped =~ s/\001\001/\000/g;
  77     $escaped =~ s/\001\002/\001/g;
  78
  79     return $escaped;
  80 }
  81
  82 ##
  83 # escape
  84 #
  85 # Escapes null-bytes for signal transfer.  Used to transfer binary data
  86 # in null-terminated strings.  Returns the escaped data.  All data send
  87 # via mime signals must be escaped.
  88 sub escape {
  89     my ($unescaped) = @_;
  90     $unescaped =~ s/\001/\001\002/g;
  91     $unescaped =~ s/\000/\001\001/g;
  92
  93     return $unescaped;
  94 }
  95
  96 ##
  97 # background_exec
  98 #
  99 # fork and execute
 100 #
 101 sub background_exec {
 102   my ($witem, $signed, $sender, $type, $cmd) = @_;
 103
 104   if ($signed == -1) {
 105     $format = "mime_data_received";
 106   } elsif ($signed == 0) {
 107     $format = "mime_data_received_signed";
 108   } elsif ($signed == 1) {
 109     $format = "mime_data_received_unknown";
 110   } elsif ($signed == 2) {
 111     $format = "mime_data_received_failed";
 112   }
 113
 114   if ($witem->{type}) {
 115     $witem->printformat(MSGLEVEL_CRAP, $format, $sender, $type);
 116   } else {
 117     Irssi::printformat(MSGLEVEL_CRAP, $format, $sender, $type);
 118   }
 119
 120   Irssi::command("EXEC " . Irssi::settings_get_str("mime_exec_param") .
 121                  $cmd);
 122 }
 123
 124 my %partial;
 125
 126 ##
 127 # process_mime_entity(WI_ITEM_REC, $signed, $sender, MIME::Entity $msg)
 128 #
 129 # -1 failure, 0 success
 130 sub process_mime_entity {
 131   my ($witem, $signed, $sender, $entity) = @_;
 132
 133   $mimetype = Mail::Field->new('Content-type', $entity->head->get('Content-Type'));
 134
 135   # check whether this is message/partial
 136   if ($mimetype->type eq  "message/partial") {
 137
 138     # without an ID i don't know what stream this is related to
 139     if ($mimetype->id eq "") {
 140       Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "no ID");
 141       return -1;
 142     }
 143
 144     # the first packet is treated seperatly
 145     if ($mimetype->number == 1) {
 146
 147       # the IDs should be unique
 148       if (defined $partial{$mimetype->id}) {
 149         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "duplicate ID");
 150         $fh = $partial{$mimetype->id}{file};
 151         $fh->close;
 152         unlink $partial{$mimetype->id}{name};
 153         undef $partial{$mimetype->id};
 154         return -1;
 155       }
 156
 157       # create a new record
 158       $partial{$mimetype->id}{received} = 1;
 159       ($fh, $partial{$mimetype->id}{name})= tempfile("msg-XXXXXXXX", SUFFIX => ".dat", DIR => Irssi::settings_get_str("mime_temp_dir"));
 160       $partial{$mimetype->id}{file} = $fh;
 161       $partial{$mimetype->id}{count} = 1;
 162       $partial{$mimetype->id}{total} = $mimetype->total;
 163
 164     } else { # 2nd and later packets
 165
 166       # detect unknown IDs
 167       if (not defined $partial{$mimetype->id}) {
 168         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "unknown ID");
 169         return -1;
 170       }
 171
 172       # the 'total' information can be set in any packet,
 173       # however it has to be the same all the time
 174       if ($mimetype->total > 0) {
 175
 176         if (($partial{$mimetype->id}{total} > 0) &&
 177             ($partial{$mimetype->id}{total} != $mimetype->total)) {
 178           Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "invalid count");
 179           $fh = $partial{$mimetype->id}{file};
 180           $fh->close;
 181           unlink $partial{$mimetype->id}{name};
 182           undef $partial{$mimetype->id};
 183           return -1;
 184         }
 185
 186         $partial{$mimetype->id}{total} = $mimetype->total;
 187
 188       }
 189
 190       # we expect to receive packets in order
 191       if ($mimetype->number != ($partial{$mimetype->id}{count} + 1)) {
 192         Irssi::printformat(MSGLEVEL_CRAP, 'message_partial_failure', "invalid sequence number");
 193         $fh = $partial{$mimetype->id}{file};
 194         $fh->close;
 195         unlink $partial{$mimetype->id}{name};
 196         undef $partial{$mimetype->id};
 197         return -1;
 198       }
 199
 200       # update our sequence record and save the packet
 201       $partial{$mimetype->id}{count} = $mimetype->number;
 202
 203     }
 204
 205     # and save the packet
 206     $fh = $partial{$mimetype->id}{file};
 207     if ($io = $entity->bodyhandle->open("r")) {
 208       while (defined($_ = $io->getline)) { print $fh $_ }
 209       $io->close;
 210     }
 211
 212     # return if this wasn't the last packet
 213     if (($partial{$mimetype->id}{total} == 0) ||
 214         ($partial{$mimetype->id}{count} < $partial{$mimetype->id}{total})) {
 215       return 1;
 216     }
 217
 218     # last packet...
 219     $tempfile = $partial{$mimetype->id}{name};
 220     $fh = $partial{$mimetype->id}{file};
 221     $fh->close;
 222     undef $partial{$mimetype->id};
 223
 224     $parser = new MIME::Parser;
 225     $parser->output_dir(Irssi::settings_get_str("mime_temp_dir"));
 226     $mime = $parser->parse_open($tempfile);
 227
 228     $ret = process_mime_entity($witem, $signed, $sender, $mime);
 229
 230     $parser->filer->purge;
 231     unlink $tempfile;
 232     return $ret;
 233
 234   }
 235
 236   # we could check for */parityfec (RTP packets) rfc2733, 3009
 237
 238   # save to temporary file
 239   ($fh, $tempfile) = tempfile("msg-XXXXXXXX", SUFFIX => ".dat", DIR => Irssi::settings_get_str("mime_temp_dir"));
 240   if ($io = $entity->open("r")) {
 241     while (defined($_ = $io->getline)) { print $fh $_; }
 242     $io->close;
 243   }
 244   close $fh;
 245
 246   # try to handle it
 247   foreach $mcap (@mcaps) {
 248
 249     $cmd = $mcap->viewCmd($mimetype->type, $tempfile);
 250     next if not defined $cmd;
 251
 252     background_exec($witem, $signed, $sender, $mimetype->type, $cmd);
 253     return 1;
 254   }
 255
 256   unlink $tempfile if Irssi::settings_get_bool("mime_unlink_tempfiles");
 257   return $mimetype->type;
 258 }
 259
 260 ##
 261 # sig_mime
 262 #
 263 # signal handler for incoming MIME type messages.  If the encoding or
 264 # the content type are missing or not parsable, they default to binary
 265 # and application/octet-stream respectivly.  If a decoder for the given
 266 # transfer encoding is available, the message is decoded.  If a handler
 267 # for the given content type is available in one of the mailcap databases,
 268 # the handler is invoked and the signal is stopped.  The mailcap databases
 269 # are scanned in order of loading.  Temporary files are unlinked if the
 270 # setting mime_unlink_tempfiles is true.
 271 sub sig_mime {
 272
 273     my ($server, $witem, $blob, $sender, $verified) = @_;
 274
 275     $parser = new MIME::Parser;
 276     $parser->output_dir(Irssi::settings_get_str("mime_temp_dir"));
 277     $mime = $parser->parse_data(unescape($blob));
 278
 279     $ret = process_mime_entity($witem, $verified, $sender, $mime);
 280
 281     $parser->filer->purge;
 282
 283     if ($ret == 1) {
 284         Irssi::signal_stop();
 285     } elsif  ($ret == -1) {
 286         return;
 287     } else {
 288         $theme = $witem->{theme} || Irssi::current_theme;
 289         $format = $theme->get_format("fe-common/silc", "message_data");
 290         $format =~ s/\$0/$sender/;
 291         $format =~ s/\$1/$ret/;
 292         if ($witem->{type}) {
 293             $witem->print($theme->format_expand($format));
 294         } else {
 295             Irssi::print($theme->format_expand($format));
 296         }
 297         Irssi::signal_stop();
 298     }
 299 }
 300
 301 ##
 302 # cmd_mmsg
 303 #
 304 # Sends a file with a given MIME type and transfer encoding.
 305 #
 306 # MMSG [<-sign>] [<-channel>] <target> <file> [<type>  [<encoding>]]
 307 #
 308 # Sends a private data message to other user in the network.  The message
 309 # will be send as a MIME encoded data message.
 310 #
 311 # If -channel option is provided then this command actually send channel
 312 # message to the specified channel.  The message IS NOT private message, it
 313 # is normal channel message.
 314 #
 315 # If the -sign optin is provided, the message will be additionally
 316 # signed.
 317 #
 318 # Messages that exceed roughly 64k have to be split up into smaller packets.
 319 # This is done automatically.
 320 #
 321 # If no transfer-encoding is given it defaults to binary or 7bit for messages
 322 # that have to be split up.
 323 #
 324 # If no content-type is given it is guessed using a MIME magic file.
 325 #
 326 # Settings
 327 #
 328 #   mime_magic            - path to MIME magic file, or internal
 329 #                           defaults if empty
 330 #   mime_default_encoding - encoding to use if none specified
 331 #   mime_temp_dir         - where to store temporary files
 332 #
 333 # Examples
 334 #
 335 # /MMSG Foobar smiley.gif image/gif binary
 336 # /MMSG -channel silc silc.patch text/x-patch 7bit
 337 # /MMSG * boing.mp3 audio/mpeg
 338 sub cmd_mmsg {
 339     my ($data, $server, $witem) = @_;
 340
 341     if ($server->{chat_type} ne "SILC") {
 342         Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_chattype');
 343         return;
 344     }
 345
 346     ($sign, $is_channel, $target, $file, $type, $encoding) =
 347         $data =~ /^\s*(?:(-sign)?\s+)?    # match the -sign
 348                   \s*(?:(-channel)?\s+)?  # match the -channel
 349                   (\*|\S+)\s+             # target
 350                   (\S+)                   # filename
 351                   (?:\s+(\S+)             # mime type
 352                      (?:\s+(\S+))?)?\s*   # encoding
 353                  $/ix;
 354
 355     Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_parameters'), return
 356         if ($target eq "") or ($file eq "");
 357
 358     Irssi::printformat(MSGLEVEL_CRAP, 'mmsg_file', $file), return
 359         if not ( -f $file );
 360
 361     $type = $magic->checktype_filename($file)
 362         if not defined $type;
 363     $encoding = Irssi::settings_get_str("mime_default_encoding")
 364         if not defined $encoding;
 365
 366     # does the target exist? we don't test that... especially the
 367     # -channel parameter is ignored :/
 368
 369     if ($target eq "*") {
 370
 371       $is_channel = ($witem->{type} eq "CHANNEL" ? "-channel" : "");
 372       $target = $witem->{name};
 373
 374     }
 375
 376     $entity = new MIME::Entity->build(
 377         'MIME-Version' => "1.0",
 378         Encoding       => $encoding,
 379         Type           => $type,
 380         Path           => $file
 381     );
 382
 383     ($fh, $tempfile) = tempfile( DIR => Irssi::settings_get_str("mime_temp_dir"));
 384     $entity->print($fh);
 385     close $fh;
 386
 387     $is_channel = (lc($is_channel) eq "-channel" ? 1 : 0);
 388     $sign = (lc($sign) eq "-sign" ? 1 : 0);
 389
 390     if ($is_channel) {
 391       $dest = $server->channel_find($target);
 392     } else {
 393       $dest = $server->query_find($target);
 394     }
 395
 396
 397     # 21:27 <@pekka> c0ffee: the core routines will crop the message if it
 398     #                doesn't fit.. I would use a bit shorter than the MAX_LEN
 399     # 21:28 <@pekka> c0ffee: -1024 bytes is sufficient
 400     # 21:28 <@pekka> c0ffee: should be sufficient in all possible cases
 401     if ((stat($tempfile))[7] < 0xfbff) {
 402       $format = ($sign ? "mime_data_send_signed" : "mime_data_send");
 403       if ($dest->{type}) {
 404         $dest->printformat(MSGLEVEL_CRAP, $format, $type);
 405       } else {
 406         Irssi::printformat(MSGLEVEL_CRAP, $format, $type);
 407       }
 408
 409       unlink $tempfile;
 410       Irssi::signal_emit("mime-send", $server, \$is_channel,
 411                          $target, escape($entity->stringify), \$sign);
 412     } else {
 413
 414       $format = ($sign ? "mime_data_multi_signed" : "mime_data_multi");
 415       $chunks = ceil((stat $tempfile)[7] / 0xfb00);
 416       if ($dest->{type}) {
 417         $dest->printformat(MSGLEVEL_CRAP, $format, $type, $chunks);
 418       } else {
 419         Irssi::printformat(MSGLEVEL_CRAP, $format, $type, $chunks);
 420       }
 421
 422       open TFILE, $tempfile;
 423       $id = sprintf "id-%06d-%08d\@%s", int(rand(65535)), time(), hostname();;
 424       $chunks = 0;
 425       do {
 426         read TFILE, $data, 0xfb00;
 427         $chunks++;
 428
 429         $entity = new MIME::Entity->build(
 430             'MIME-Version' => "1.0",
 431             Encoding       => "binary",
 432             Type           => "message/partial; id=\"$id\"; number=$chunks" .
 433                                 (eof(TFILE) ? "; total=$chunks" : ""),
 434             Data           => $data
 435         );
 436         Irssi::signal_emit("mime-send", $server, \$is_channel,
 437                                 $target, escape($entity->stringify), \$sign);
 438
 439     } while (!eof(TFILE));
 440     close TFILE;
 441
 442     unlink $tempfile;
 443   }
 444 }
 445
 446 # Signal handlers
 447 Irssi::signal_add("mime", "sig_mime");
 448
 449 # Commands
 450 Irssi::command_bind("mmsg", "cmd_mmsg");
 451
 452 # Settings
 453 Irssi::settings_add_str("misc", "mime_database",
 454     "$ENV{HOME}/.mailcap /etc/mailcap");
 455 Irssi::settings_add_bool("misc", "mime_unlink_tempfiles", 1);
 456 Irssi::settings_add_str("misc", "mime_default_encoding", "binary");
 457 Irssi::settings_add_bool("misc", "mime_verbose", 0);
 458 Irssi::settings_add_str("misc", "mime_temp_dir", "/tmp");
 459 Irssi::settings_add_str("misc", "mime_magic", "");
 460 Irssi::settings_add_str("misc", "mime_exec_param", "");
 461
 462 # Init
 463 Irssi::theme_register(['load_mailcap', 'Loading mailcaps from {hilight $0}',
 464         'load_mailcap_fail', 'Couldn\'t find {hilight $0}',
 465         'message_partial_failure', 'message/partial: {hilight $0-}',
 466         'mmsg_chattype', 'command was not designed for this chat type',
 467         'mmsg_parameters', 'not enough parameters given',
 468         'mmsg_file', 'File {hilight $0} not found',
 469         'load_mime_magic', 'Loading MIME magic types from {hilight $0}',
 470         'no_temp_dir', 'Directory {hilight $0} does not exist, defaulting to /tmp',
 471         'mime_data_received', '{nick $0} sent "{hilight $1}" data message',
 472         'mime_data_received_signed', '{nick $0} sent "{hilight $1}" data message (signature {flag_signed})',
 473         'mime_data_received_unknown', '{nick $0} sent "{hilight $1}" data message (signature {flag_unknown})',
 474         'mime_data_received_failed', '{nick $0} sent "{hilight $1}" data message (signature {flag_failed})',
 475         'mime_data_send', 'sending "{hilight $0}" data message',
 476         'mime_data_send_signed', 'sending "{hilight $0}" data message (signature {flag_signed})',
 477         'mime_data_multi', 'sending "{hilight $0}" data message ($1 chunks)',
 478         'mime_data_multi_signed', 'sending "{hilight $0}" data message ($1 chunks, signaute {flag_signed})']);
 479
 480
 481
 482 read_mime_database();