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