path: root/img/dist/IM/imcat.in

#! @im_path_perl@
################################################################
###
###				 imcat
###
### Author:  Internet Message Group <img@mew.org>
### Created: May  5, 1997
### Revised: Feb 28, 2000
###

BEGIN {
    @im_my_siteperl@
    @im_src_siteperl@
};

my $VERSION = "imcat version 20000228(IM140)";

$Prog = 'imcat';

##
## Require packages
##

use IM::Config;
use IM::Util;
use integer;
use strict;
use vars qw($Prog $EXPLANATION @EnvConfig @OptConfig
	    @servers
	    $opt_src $opt_join $opt_boundary
	    $opt_verbose $opt_debug $opt_help);

##
## Environments
##

$EXPLANATION = "
imcat :: Display Messages
$VERSION

Usage: imcat [options] msg
";

@EnvConfig = (
    'NNTPSERVERS;s;;' => "Default NNTP servers.",
     );

@OptConfig = (
    'src;F;;'      => "Folder.",
    'join;b;;'     => "join partial messages.",
    'boundary;b;;' => "Print start boundary for Mew.",
    'verbose;b;;'  => 'With verbose messages.',
    'debug;d;;'    => "With debug message.",
    'help;b;;'     => "Show this message.",
    'SSHServer;s;localhost;SSH_server'
                       => 'SSH port relay server.',
    );

##
## Profile and option processing
##

init_opt(\@OptConfig);
read_env(\@EnvConfig);
read_cfg();
read_opt(\@ARGV); # help?
help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help;

debug_option($opt_debug) if $opt_debug;

##
## Main
##

my $msg = $ARGV[0];
my $BOUNDARY="---BEGIN-IMGET-MESSAGE---\n";

unless ($msg) {
    im_die("no message specified.\n");
}
binmode(STDOUT);

if ($msg =~ /^http:/i) {
    require IM::Http && import IM::Http qw(http_process);
    my ($rc, $data) = http_process($msg, httpproxy(), noproxy());
    if ($rc < 0) {
	im_die("can't access to message $msg.\n");
    }
    print $BOUNDARY if $opt_boundary;
    foreach (@$data) {
	print;
    }
} elsif ($opt_src =~ /(^[+=~\/])|(^[a-zA-Z]:)/) {
    # Mail/News folder
    require IM::Folder && import IM::Folder qw(message_name);

    if ($msg =~ /\@/) {
	require IM::History &&
	    import IM::History qw(history_open history_lookup history_close);

	if (history_open(0) < 0) {
	    im_die("can not open history.\n");
	    exit $EXIT_ERROR;
	}
	my $msg = history_lookup($msg, 'LookUpMsg');
	history_close();
	if ($msg eq '') {
	    im_info("message is not found.\n");
	    exit $EXIT_ERROR;
	}
	&join_msg($msg) if ($opt_join);
	print $BOUNDARY if $opt_boundary;
	foreach (split(',', $msg)) {
	    my $path = &expand_path($_);
	    if (im_open(\*MSG, "<$path")) {

		while (<MSG>) {
		    print;
		}
		close(MSG);
		exit $EXIT_SUCCESS;
	    }
	}
	im_warn("message $msg is missing.\n");
	exit $EXIT_ERROR;
    } else {
	my $path = &message_name($opt_src, $msg);
	&join_msg($path) if ($opt_join);
	print $BOUNDARY if $opt_boundary;
	if (im_open(\*MSG, "<$path")) {
	    while (<MSG>) {
		print;
	    }
	    close(MSG);
	} else {
	    im_warn("no message $msg in folder $opt_src.\n");
	}
    }
} elsif ($opt_src =~ /^-/) {
    # News spool (-group[@server])
    require IM::Nntp && import IM::Nntp qw(nntp_get_message);
    my ($rc, $art) = nntp_get_message($opt_src, $msg);
    im_die($art) if ($rc < 0);
    print $BOUNDARY if $opt_boundary;
    foreach (@$art) {
	print;
    }
} elsif ($opt_src =~ /^(%.*)/) {
    # IMAP folder (%folder[:[user[/auth]]@server])
    require IM::Imap && import IM::Imap;
    require IM::GetPass && import IM::GetPass;
    my ($folder, $auth, $user, $host);
    
    $folder = $1;
    if ($folder !~ /[:\@]/) {
	# Use ImapAccount spec, unless user or host is specified.
	(my $dummy, $auth, $user, $host) = imap_spec('');
	$folder =~ s/^%//;
    } else {
	($folder, $auth, $user, $host) = imap_spec($folder);
    }

    my ($pass, $agtfound, $interact) = getpass('imap', $auth, $host, $user);
    im_warn("accessing IMAP/$auth:$user\@$host\n") if (&verbose);

    my ($rc, $HANDLE) = &imap_open($auth, $host, $user, $pass);
    if ($rc < 0) {
	my $prompt = lc("imap/$auth:$user\@$host");
	im_err("invalid password ($prompt).\n");
	&savepass('imap', $auth, $host, $user, '')
	    if ($agtfound && &usepwagent());
	exit $EXIT_ERROR;
    }
    &savepass('imap', $auth, $host, $user, $pass)
	if ($interact && $pass ne '' && &usepwagent());
    my $msgs = &imap_select($HANDLE, $folder, 1);
    if ($msgs < 0) {
	&imap_close($HANDLE);
	im_die("can't access to $folder\n");
    } else {
	my ($rc, $message) = &imap_get($HANDLE, $msg);
	&imap_close($HANDLE);
	if ($rc < 0) {
	    im_die("can't access to message $msg in \%$folder.\n");
	} elsif ($rc > 0) {
	    im_die("message $msg not found in \%$folder\n");
	}
	print $BOUNDARY if $opt_boundary;
	foreach (@$message) {
	    print;
	}
    }
}

exit $EXIT_SUCCESS;

sub join_msg ($) {
    my $msg = shift;
    my $path;
    local $_;
    require IM::History && import IM::History qw(history_open history_lookup
						 history_close);

    # get master Message-ID
    my $header = '';
    foreach (split(',', $msg)) {
	if (/^\+/) {
	    $path = &expand_path($_);
	} else {
	    $path = $_;
	}
	if (im_open(\*MSG, "<$path")) {
	    $/ = "\n\n";
	    $header = <MSG>;
	    $/ = "\n";
	    close(MSG);
	    last;
	}
    }

    if ($header eq '') {
	im_err("specified message is not found at $path.\n");
	exit $EXIT_ERROR;
    }

    $header =~ s/\n\s+//g;
    $header =~ s/[ \t]+//g;
    $header =~ s/\n/;\n/g;
    $header = "\n$header";

    my $master = '';

    if ($header =~ m|\nContent-Type:Message/partial;(.*;)?id=([^;]+);|i) {
	$master = $2;
	$master =~ s/^"(.*)"$/$1/;
    } else {
	im_err("specified message is not a partial.\n");
	exit $EXIT_ERROR;
    }
    im_notice("Master Message-ID: $master.\n");

    # get Message-IDs of partial
    if (history_open(0) < 0) {
	im_err("can not open history.\n");
	exit $EXIT_ERROR;
    }
    my $ids = history_lookup("partial:$master", 'LookUpMsg');
    if ($ids eq '') {
	im_err("information on partial messages is not found in history.\n");
	exit $EXIT_ERROR;
    }
    im_notice("partial Message-IDs: $ids.\n");

    # get path and part number on each part
    my @paths;
    my $total = 0;
    foreach (split(',', $ids)) {
	my $locate = history_lookup($_, 'LookUpMsg');
	if ($locate eq '') {
	    im_warn("message $_ not found, skipping.\n");
	    next;
	}
	my $path = &expand_path($locate);
	if ($path eq '') {
	    im_warn("no path for message $locate, skipping.\n");
	    next;
	}
	if (im_open(\*MSG, "<$path")) {
	    $/ = "\n\n";
	    $header = <MSG>;
	    $/ = "\n";
	    close(MSG);
	}

	$header =~ s/\n\s+//g;
	$header =~ s/[ \t]+//g;
	$header =~ s/\n/;\n/g;
	$header = "\n$header";

	my $number = 0;
	my $this_total = 0;
	if ($header =~ /\nContent-Type:Message\/partial(;[^\n]+)\n/i) {
	    my $rest = $1;
	    if ($rest =~ /;number=(\d+);/i) {
		$number = $1;
	    }
	    if ($rest =~ /;total=(\d+);/i) {
		$this_total = $1;
	    }
	}
	if ($number == 0 || $this_total == 0) {
	    im_warn("$_: not a partial message, skipping.\n");
	    next;
	}
	if ($total) {
	    if ($total != $this_total) {
		im_warn("$_: total of partial messages mismatch, skipping.\n");
		next;
	    }
	} else {
	    $total = $this_total;
	}
	$paths[$number] = $path;
	im_notice("$path is part $number.\n");
    }
    history_close();

    # check existance of all partial messages
    my $missing = 0;
    my $i;
    for ($i = 1; $i <= $#paths; $i++) {
	if ($paths[$i] eq '') {
	    im_err("part $i is missing.\n");
	    exit $EXIT_SUCCESS;
	}
    }

    # show in sequence
    for ($i = 1; $i <= $#paths; $i++) {
	if (im_open(\*MSG, "<$paths[$i]")) {
	    $/ = "\n\n";
	    if ($i == 1) {		# first partial message
		my $header = <MSG>;	# header of enclosing message
		my $skip = 0;
		foreach (split("\n", $header)) {
		    next if (/^[ \t]/ && $skip);
		    $skip = 0;
		    if (/^(Content-|Subject|Message-ID|Encrypted|MIME-Version)/i) {
			$skip = 1;
			next;
		    }
		    last if (/^$/);
		    print "$_\n";
		}
		$header = <MSG>;	# header of enclosed message
		$skip = 0;
		foreach (split("\n", $header)) {
		    next if (/^[ \t]/ && $skip);
		    $skip = 0;
                    unless (/^(Content-|Subject|Message-ID|Encrypted|MIME-Version)/i || /^[ \t]/) {
			$skip = 1;
			next;
		    }
		    last if (/^$/);
		    print "$_\n";
		}
		print "\n";
	    } else {
		# skip header part
		<MSG>;
	    }
	    $/ = "\n";
	    while (<MSG>) {
		print;
	    }
	    close(MSG);
	}
    }

    exit $EXIT_SUCCESS;
}

### Copyright (C) 1997, 1998, 1999 IM developing team
### All rights reserved.
### 
### Redistribution and use in source and binary forms, with or without
### modification, are permitted provided that the following conditions
### are met:
### 
### 1. Redistributions of source code must retain the above copyright
###    notice, this list of conditions and the following disclaimer.
### 2. Redistributions in binary form must reproduce the above copyright
###    notice, this list of conditions and the following disclaimer in the
###    documentation and/or other materials provided with the distribution.
### 3. Neither the name of the team nor the names of its contributors
###    may be used to endorse or promote products derived from this software
###    without specific prior written permission.
### 
### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

### Local Variables:
### mode: perl
### End: