#!/usr/bin/perl

use MIME::Entity;
use News::NNTPClient;
use String::CRC32;
use Getopt::Std;
use File::Basename;
use HTTP::Date;

######################################################
# preferences

$host		= 'login:pass@news.foo.net';
$from 		= '"UltiPost User" <ultipost@foo.net>';
$organization	= 'The UltiPosters';
$subject	= '$file_basename ($file_size Bytes,$file_crc32 CRC) File $i of $numfiles';
$newsgroup 	= 'alt.binaries.test';
$references	= '$msgid_first';
$comment	= 'Send with UltiPost.pl';
#$signature	= ' UltiPost User <ultipost@foo.net> \n'.
#		  ' http://www.ibiblio.org/pub/Linux/system/news/transport/';
$signature      = '.signature';

# debug level for News::NNTPClient
$debuglevel = 1;

######################################################
# code follows

$version = "0.9.2";

$progname = basename $0;

if ($#ARGV == -1) {
  &printhelp;      
  exit(0);
}

getopts('Bhf:o:s:n:R:c:H:S:N:t:C:');

if ($opt_h) {
  &printhelp;
  exit(0);
}

$host = $opt_H if ($opt_H);
$comment = $opt_c if ($opt_c);
if ($opt_C) {
  if (open(COMMENTFILE, $opt_C)) {
    $/ = "";
    chomp($comment = <COMMENTFILE>);
    $/ = "\n";
    close COMMENTFILE;
    $comment .= "\n\n";
  } else {
    $comment = $opt_C."\n".$comment;
  }
}
$references = $opt_R if ($opt_R);
$newsgroup = $opt_n if ($opt_n);
$subject = $opt_s if ($opt_s);
$subject = $opt_S.$subject;
$subject =~ s/\s+/ /g;
$organization = $opt_o if ($opt_o);
$from = $opt_f if ($opt_f);
$signature = $opt_t if ($opt_t);

if (open(SIGNATUREFILE, $signature)) {
  $/ = "";
  chomp($signature = <SIGNATUREFILE>);
  $/ = "\n";
  close SIGNATUREFILE;
}

while ($file = shift @ARGV) {
  @TFiles = (@TFiles, glob($file));
}

while ($file = shift @TFiles) {
  next unless (-e $file);
  next if (-d $file || ! -r $file);
  push @Files, $file;
}

$numfiles = $#Files +1;
$msgidbase = crc32($subject.$comment);

$i = 0;

if ($host=~m/^(.*?)\@(.*)/g) {
  $hhost=$2;
 ($authl,$authp) = split(":",$1);

}
    
($host, $port, @Rest) = split(":", $hhost);
$port = 119 unless ($port =~ m/\d+/);

if (! $opt_B) {
  $c = new News::NNTPClient($host , $port, $debuglevel);
  $c->authinfo($authl, $authp) if ($authl);
  if (!$c->postok || $c->code == 502) {
    print STDERR "Not allowed to post - will use batch mode.\n";
    $opt_B = 1;
  }
}

$postdate = time2str(time);

foreach $file (@Files) {
  $i++;

  next if ($opt_N && $i < $opt_N);

  $file_basename = basename($file);
  print STDERR "Posting $file_basename ($i/$numfiles)\n" unless $opt_B;

  @Comment = &strtoa(&expandvars($comment));

  @Signature = &strtoa(&expandvars($signature));
  $#Signature = 3 if ($#Signature > 3);

  @file_stat = stat($file);
  $file_size = $file_stat[7];

  open(FILE, $file) || next;
  $file_crc32 = sprintf("%X",crc32(*FILE));
  $file_crc32 =~ s/\s//g;
  close(FILE);
 
  $msgid_act = "<".$file_crc32."-".$msgidbase."\@ghosthost.nonymous.org>";
  $msgid_first = "<".$file_crc32."-".$msgidbase."\@ghosthost.nonymous.org>"
   if ($i == 1);

  $top = MIME::Entity->build(
	Type		=> "multipart/mixed",
	'From'		=> &expandvars($from),
	'Newsgroups:'	=> &expandvars($newsgroup),
	'Subject'	=> &expandvars($subject),
	'Message-ID'	=> &expandvars($msgid_act),
	'Organization'	=> &expandvars($organization),
	'X-Organization'=> &expandvars($organization),
	'References'	=> &reference($i, $msgidbase),
	'Date'		=> $postdate,
	'Path:'		=> "news.nonymous.org!not-for-mail",
	'X-Mailer'	=> "UltiPost (Version $version; $^O; perl $])");

  $top->attach(
	Type		=> "text/plain",
	Encoding	=> "quoted-printable",
	Data		=> \@Comment) unless ($comment =~ m/^$/);

  $top->sign(Signature => \@Signature) unless ($signature =~ m/^$/);

  ($file_basename, $file_path, $file_suffix) = fileparse($file);
  if ($file_suffix =~ m/jpg|jpeg/i) {
    $file_mimetype = "image/jpeg";
  } else {
    $file_mimetype = "application/octet-stream";
  }

  $top->attach(
	Path		=> $file,
	Type		=> $file_mimetype,
	Encoding	=> "base64");

  $top->sync_headers(Length=>'COMPUTE');


  if ($opt_B) {
    $clen = length($top->stringify);
    print "#!rnews $clen\n";
    $top->print(\*STDOUT);
  } else {
    $c->post(split("\n",$top->stringify));
  }
}
$c->DESTROY unless ($opt_B);

sub expandvars {
  my $estring = shift;
  $estring =~ s/\$(ENV\{.*?\}|[\w_\'\`\#-]+)/eval('$'.$1)/ge;
  while ($estring =~ m/ROT13\{(.*?)\}/) {
    $rot13string1 = $1;
    $rot13string2 = $rot13string1;
    $rot13string2 =~ tr/a-mn-z/n-za-m/; 
    $rot13string2 =~ tr/A-MN-Z/N-ZA-M/;
    $estring =~ s/ROT13\{$rot13string1\}/$rot13string2/;
  }
  $estring=~ s/\\n/\n/g;
  return $estring;
}

sub strtoa {
  my $string = shift;
  my @Array1 = split("\n", $string);
  my @Array2 = '';

  foreach $string (@Array1) {
    $string.="\n";
    push @Array2, $string;
  }
  return @Array2;
}

sub reference {
  my $rnum=shift;
  my $rmsgidbase = shift;
  if ($opt_R) {
    return &expandvars($references);
  }
  if ($rnum == 1) {
    return undef;
  } else {
    return &expandvars($references);
  }
}

sub printhelp {
  print <<ENDHELP;
$progname [OPTION]... FILE...
Post binary files to newsgroups

  -h		This help
  -H HOST	Usenet server address
		also understands HOST:PORTNUM
  -f FROM	From header
  -o ORG	Organization header
  -s SUBJECT	Subject header
  -S SUBJPRE	Subject prefix
  -n GROUP	Newsgroups header
  -R REF	References header
  -c TEXT	Comment
  -C TEXT	Comment prefix
  -t TEXT	Text signature to append
  -B		Build an rpost batch to stdout,
		also useful to see what would be posted
  -N NUM	Start posting with NUMth file

Have a look on the preferences set in the source code before
trying to use any options!

You should also have a look at the included perldoc documentation.
ENDHELP
}

__END__

=pod

=head1 NAME

UltiPost.pl - Post binary files to usenet newsgroups

=head1 SYNOPSIS

ultipost.pl [OPTION]... FILE...

=head1 README

UltiPost.pl is an automatic binary file poster.
It may be used to post picture collections to usenet.
Messages are MIME-compliant.

You are not allowed to use it for SPAMming!!!

=head1 OPTIONS

=over 4

=item B<-h>

A short help text.

=item B<-H> HOSTNAME

Hostname or IP address of the usenet server to access.
If none is given, the system's default one is used.

Also understands HOSTNAME:PORTNUM.

=item B<-f> FROM

From header. Specify your name and email address here.

=item B<-o> ORGANIZATION

Specify your organization. Might be overwritten by your newsserver.

=item B<-s> SUBJECT

Subject header.
Default is '$file_basename ($file_size Bytes, $file_crc32 CRC) File $i of $numfiles'.

=item B<-S> SUBJPREFIX

Subject prefix. A string that is prepended to your subject line.

=item B<-n> GROUP

Newsgroups to post to.

=item B<-R>

References header. Specify here to which Message you would like to refer.
Default is '$msgid_first'.

=item B<-c> TEXT

Comment for each article.

=item B<-C> TEXT

Comment prefix.

=item B<-t> TEXT

Text to be appended as signature.
Following netiquette quidelines, no more than 4 lines are allowed.

=item B<-B> 
     
Build an rnews batch to stdout.
Also good to see what would be done prior to posting.

=item B<-N> NUM

Start posting with NUMth file.
Use this to restart a failed posting.

=back

=head1 ROT13

UltiPost.pl can garble plain text (in options, comment, signature)
with the rot-13 algorithm.

To do this, simply encapsulate the text you would like to garble
with "ROT13{ ... }".

Be careful:
First: This is no encryption method. 
Second: Doesn't work over multiple lines.

=head1 VARIABLES

You may include any known Perl variable in your option strings.
The following ones might be useful:

=over 4

=item $i

Current article index.

=item $numfiles

Number of articles to post.

=item $from

From header.

=item $organization

Organization header.

=item $newsgroup

Newsgroups to post to.

=item $host

Hostname (or IP) of usenet server.

=item $references

Message-IDs of referenced articles.

=item $msgid_act

Message-ID of current article.

=item $msgid_first

Message-ID of first article.

=item $file_basename

File name without path.

=item $file_size

Filesize in bytes.

=item $file_crc32

Checksum of attached file.

=back

Set option strings into single quotes to avoid expansion by the shell.

=head1 BUGS

Yes, there might be some. But this script seems to do its job...

=head1 AUTHOR

The MIP <the_mip@gmx.fr>

=head1 SCRIPT CATEGORIES

Misc.

=cut