Hi,
I used to post my documents through mail2news gateway, but
unfortunately I found out the Approved headers was beeing stripped
along the way. So I wrote small and simple Perl script to
talk directly to NNTP or SMTP port.
I'm using Procmail cron to post my regular posting with this
script now. If anybody has a need for this, you can get it from:
To: <jari.aalto@poboxes.com>
Subject: send smtp-helo.pl
Comments for improvements are also welcome.
jari
--Multipart_Mon_Aug_24_22:37:52_1998-1
Content-Type: application/octet-stream
Content-Disposition: attachment; filename="smtp-helo.pl"
Content-Transfer-Encoding: 7bit
#!/usr/local/bin/perl
#
# @(#) Perl - Send email message to SMTP or post to usenet via NNTP port.
# @(#) $Id: smtp-helo.pl,v 1.9 1998/08/22 23:24:32 jaalto Exp $
#
# File id
#
# .Copyright (C) 1998 Jari Aalto
# .Created: 1998-07
# .$Contactid: <jari.aalto@poboxes.com> $
# .$Keywords: smtp nntp usenet post mail perl $
# .$Url: http://www.netforward.com/poboxes/?jari.aalto $
# .$Perl: 5.003 $
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation,
# Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# With this perl script you can feed Email message directly to
# SMTP port or send a News Message to Usenet news. This software
# is dedicated to FAQ maintainers and people that send
# announcements in regular intervals.
#
# You could add a cron entry to automate postings. See --help
# switch for more details.
#
# Description
#
# With this perl script you can feed Email message directly to
# SMTP port or send a News Message to Usenet news. This software
# is dedicated to FAQ maintainers and people that send
# announcements in regular intervals.
#
# You could add a cron entry to automate postings. See --help
# switch for more details.
#
# Change Log: (none)
BEGIN
{
require 5.003; # We use prototypes here
}
use strict;
use integer;
use English;
use Getopt::Long;
use vars qw
(
$PortSmtp
$PortNews
);
*PortSmtp = \25;
*PortNews = \119;
# ****************************************************************************
#
# DESCRIPTION
#
# Set global variables for the program
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub Initialize ()
{
use vars qw
(
$PROGNAME
$LIB
$FILE_ID
$VERSION
$CONTACT
$URL
);
$PROGNAME = "smtp-helo.pl";
$LIB = $PROGNAME;
$FILE_ID = q$Id: smtp-helo.pl,v 1.9 1998/08/22 23:24:32 jaalto Exp $;
$VERSION = (split (' ', $FILE_ID))[2];
$CONTACT = "<jari.aalto\@poboxes.com>";
$URL = "ftp://cs.uta.fi/pub/ssjaaa/";
}
# ***************************************************************** &help ****
#
# DESCRIPTION
#
# Print help and exit.
#
# INPUT PARAMETERS
#
# $msg [optional] Reason why function was called.
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
=pod
=head1 NAME
smtp-helo.pl -- Send message via SMTP protocol (send mail, post news)
=head1 SYNOPSIS
% smtp-helo.pl --from me@here.com \
--to to@somewhere.com \
--server mail.server.com \
[--test]
[--helo here.com]
[--port 25]
message.txt ..
=head1 OPTIONS
=over 4
=item B<--from STR>
=item B<--helo STR>
The server that is given to HELO prompt. This should be same host address
as what is in your email address. If you try to give something else
than your host addresses, the smtp will still reveal the original
host by doing reverse IP lookup. (See received headers and address
inside [] brackets)
=item B<--msgid STR>
Set Message-Id header to STR. Existing Message/If is replaced. If you use
this option, make sure you understand how message id is generated and what
is the correct format. Refer to RFC 1036.
=item B<--news STR>
Post to usenet news. Port is by default selected 119 unless changed with
B<--port> switch.
=item B<--newsgroups STR>
List of newsgroups where to post. Do not use B<--to> if you use this
switch.
=item B<--port N>
Port number where to connect in mailserver.
25 is usually sendmail port number. This is default is B<--port>
option is not given.
119 is Usenet news port number.
=item B<--to STR>
To address, where message is beeing sent. Do not use B<--newsgroups>
if you use this switch.
=item B<--server NAME-OR-IP-ADDR>
The server where to connect with B<--port> option to do the actual delivery.
=item B<--verbose> B<-v>
Turn on verbose messages.
=item B<--Version> B<-V>
Print program version and contact info.
=item B<--debug> B<-d>
Turn on debug.
=item B<--test> B<-t>
Test mode. Do not actually send or connect anywhere.
=item B<--help> B<-h>
Print help page.
=back
=head1 DESCRIPTION
This Small perl script sends messages via mail or posts them to newsgroup.
The message file is already composed and it should contain any any additional
header. The sned is done by connecting via telnet to SMTP/NEWS port and
talking smtp.
=head1 EXAMPLES
=head2 Mail
To send a message to email address, use command below. Remember that the
.txt file you're sending contains I<only> body and no headers.
% smtp-helo.pl --from me@here.com \
--to to@somewhere.com \
--server mail.server \
message-body.txt ..
=head2 Usenet News
To send a message to usenet news, use command below. The .txt file I<must>
contain complete RFC compliant usenet post, which includes headers, one
empty line and then body. Header I<Newsgroups:> must exist in the post, but
it's content can be replaced with the value in B<--newsgroups> switch.
% smtp-helo.pl --from me@here.com \
--server usenet.server \
--news \
[--newsgroups "comp.test,local.test"] \
full-message-with-headers.txt ..
Use the B<--test> switch to ensure that everything looks okay before
actual posting.
The Message-Id header is also generated if it doesn't exist.
=cut
sub Help (;$)
{
my $msg = shift; # optional arg, why are we here...
local ($ARG, *F);
# Read first line of our perl script to find out the Perl
# interpreter in use.
open F, $0 or die "$0 $ERRNO";
$ARG = <F>;
close F;
if ( m,(/[^ \s]+), ) # The perl interpreter --> $1
{
system "$1 -MPod::Text -e 'pod2text shift; exit' $0";
print ">> $msg\n" if defined $msg;
}
else
{
warn "Can't find perl, please run manually:\n pod2text $0\n"
}
exit 1;
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check Newsgroup header value for invalid characters. Die on error.
#
# INPUT PARAMETERS
#
# $string value of header
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub CheckNewsgroupName ($)
{
my $id = "$LIB.CheckNewsgroupName";
local $ARG = shift;
/([^-,.a-zA-Z0-9]+)/ and
die "$id: Newsgroup name is invalid, [$1] [$ARG]";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Check Somewhat valid Mmessage-Id Syntax
#
# INPUT PARAMETERS
#
# $string value of header
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub CheckMessageId ($)
{
my $id = "$LIB.CheckMessageId";
local $ARG = shift;
# No spaces between <>
# To the right there should be "@domain.name.net"
# domain part: ".net" ".com" ".fi"
if ( /<.*\s.*>/ )
{
die "$id: Message-Id is invalid [$ARG]";
}
elsif ( not /@[-.\w]+>/i )
{
die "$id: Message-Id domain must be normal charset [@ARG].";
}
elsif ( not /@.+\.[a-z]{2,3}>/i )
{
die "$id: Message-Id toplevel NET must be .net .com etc. [$ARG]";
}
}
# ************************************************************** &args *******
#
# DESCRIPTION
#
# Read and interpret command line arguments ARGV. Sets global variables
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub HandleCommandLineArgs ()
{
my $id = "$LIB.HandleCommandLineArgs";
local $ARG;
use vars qw
(
$DOCUMENT_OPTION
$VERSION_OPTION
$HELP
$BEGIN_REGEXP
$END_REGEXP
$IGNORE_REGEXP
$HELO
$FROM
$TO
$PORT
$SERVER
$NEWS
$NEWSGROUPS
$MSG_ID
$SEND_TO
$QUIET
$debug
$verb
$test
);
# .................................................... read args ...
$Getopt::Long::ignorecase = 0; # Be case sensitive
$Getopt::Long::order = $REQUIRE_ORDER;
GetOptions # Getopt::Long
(
"h|help" => \$HELP
, "verbose" => \$verb
, "Version" => \$VERSION_OPTION
, "debug" => \$debug
, "t|test" => \$test
, "news" => \$NEWS
, "newsgroups=s" => \$NEWSGROUPS
, "msgid=s" => \$MSG_ID
, "from=s" => \$FROM
, "to=s" => \$TO
, "port=i" => \$PORT
, "server=s" => \$SERVER
, "helo=s" => \$HELO
);
$VERSION_OPTION and die "$VERSION $PROGNAME $CONTACT $URL\n";
$HELP and Help();
$verb = 1 if defined $debug;
$verb = 1 if defined $test;
$FROM eq '' and Help "--from missing";
$SERVER eq '' and Help "--server missing";
if ( defined $test )
{
$test = 1; print "$id: TEST MODE. WE DON'T ACTUALLY SEND MESSAGE.\n";
}
# ......................................................... news ...
if ( $TO eq '' and $NEWSGROUPS eq '' and $NEWS eq '')
{
Help "--to --newsgroups or --news needed";
}
if ( $TO ne '' and $NEWSGROUPS ne '' )
{
Help "Can't use both --to and --newsgroups";
}
$SEND_TO = $TO;
if ( $NEWSGROUPS ne '' ) # We got newsgroup names.
{
$NEWS = 1;
$ARG = $NEWSGROUPS;
CheckNewsgroupName $ARG;
$SEND_TO = $ARG;
}
if ( ($NEWS or $NEWSGROUPS ne '') and $PORT eq '' )
{
$PORT = $PortNews;
$verb and warn "$id: Using default port $PORT\n";
}
CheckMessageId $MSG_ID if defined $MSG_ID;
# ......................................................... mail ...
if ( $HELO eq '' and $FROM =~ /@(.*)/ )
{
$HELO = $1;
}
if ( $PORT eq '' )
{
$PORT = $PortSmtp;
$verb and warn "$id: Using default port $PORT\n";
}
$HELO eq '' and Help "--helo missing";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Feed News to opened connection.
#
# INPUT PARAMETERS
#
# $FH file handle
# $msg
# $grops [optional] To which newsgroups to post. This is value that
# is placed to `Newsgroups:' header.
# $msgid [optional]
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub FeedNews ($ $$ ;$)
{
my $id = "$LIB.FeedNews";
my( $F, $msg, $groups, $msgid) = @ARG;
not defined @$msg and die "$id: No message.";
my $lf = "\n"; # Linefeed
my @tmp;
local $ARG;
# The post must contain all headers, but we cange the newsgroups here
$ARG = join '', @$msg;
if ( $groups ne '' )
{
s/^(Newsgroups:)(.*)/$1 $groups/mi; # Set group(s) where to post
}
unless ( $msgid ne '' and s/^(Message-Id:.*)/$msgid/mi )
{
# Read the book "Hitchhiker's Guide to Galaxy" by
# Douglas Adams...
if ( $msgid =~ /Message-Id:\s+<.*@.*>/ )
{
# Do nothing. We suppose it's ok.
}
elsif ( $msgid =~ /^\s*<.*@.*>/ )
{
$msgid = "Message-Id: " . $msgid;
}
else
{
$msgid = "Message-Id: <"
. substr( join( "",localtime), 0, 11)
. "\@dev.null.net"
. ">"
;
}
$ARG = $msgid . "\n" . $ARG; # Add to the Beginning
$verb and print "$id: $msgid";
}
s/^To:.*\r?\n?//mi; # Kill 'To:' field
$msg = $ARG;
$groups = "";
$groups = $1 if /Newsgroups: *(.*)/i;
if ( $groups eq '' )
{
die "$id: Message didn't contain header 'Newsgroups:'\n[$msg]";
}
CheckNewsgroupName $groups;
if ( $verb )
{
print "$id: Newsgroups: $groups\n";
print "$id: $1\n" if /(Subject:*.*)/i;
}
# % telnet foo.com 119
#
# POST
# 340 send article to be posted. End with <CR-LF>.<CR-LF>
# <type message here, terminate with single line containing a ".">
# QUIT
print $F "POST$lf";
print $F join ''
, $msg
, "$lf"
, "."
, "$lf"
;
print $F "QUIT$lf";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Feed Mail to opened connection.
#
# INPUT PARAMETERS
#
# $FH File handle
# $from
# $to
# $helo
# $msg
# $msgid [optional]
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub FeedMail ($ $$ $$ ;$)
{
my $id = "$LIB.FeedMail";
my( $F, $from, $to, $helo, $msg, $msgid) = @ARG;
$from eq '' and die "$id: from missing";
$from eq '' and die "$id: to missing";
$helo eq '' and die "$id: helo missing";
my $str;
my @hdr;
if ( @hdr = grep( /^[-\w+]+: /, @$msg) )
{
die "$id: No headers allowed in post\n[@hdr]";
}
# % telnet foo.com 25
#
# HELO your.domain.com
# MAIL From: <me@nowhere.com>
# RCPT To: <bob@foo.com>
# DATA
# <type message here, terminate with single line containing a ".">
# QUIT
$str = join ''
, "HELO $helo\n"
, "MAIL From: $from\n"
, "RCPT $to\n"
;
print $str if $verb and not $test;
print $F $str;
$str = join ''
, "DATA\n"
, $msg
, "\n.\n"
;
print $F $str;
print $str if $verb and not $test;
print $F "QUIT\n";
}
# ****************************************************************************
#
# DESCRIPTION
#
# Send message via mail or post to usenet.
#
# INPUT PARAMETERS
#
# $server
# $port
# $from
# $to [optional], News use NEWSGROUPS
# $helo
# \@msg
# $msg-id [optional]
#
# RETURN VALUES
#
# none
#
# ****************************************************************************
sub Send ($$ $$$ $;$)
{
my $id = "$LIB.Send";
my($server, $port, $from, $to, $helo, $msg, $msgid) = @ARG;
$server eq '' and die "$id: server missing";
$port eq '' and die "$id: port missing";
$from eq '' and die "$id: from missing";
# $to eq '' and die "$id: to missing";
$helo eq '' and die "$id: helo missing";
not defined @$msg and die "$id: message missing";
local *PROCESS;
my $str;
my $fh = \*STDOUT;
$str = "telnet $server $port";
if ( $test )
{
print "\n$str\n";
}
else
{
open PROCESS, "|$str" or die "cannot open $server $port $ERRNO";
$fh = \*PROCESS;
}
if ( $NEWS )
{
FeedNews $fh, $msg, $to, $msgid;
}
else
{
FeedMail $fh, $from, $to, $helo, $msg, $msgid;
}
close P if not $test;
}
# ............................................................ &main ...
Initialize();
HandleCommandLineArgs();
not @ARGV and Help "No files to send given";
my $id = "$LIB.main";
local (*F, *P);
my ($file, @msg , $str);
for $file ( @ARGV )
{
not -f $file and die "$file does not exist.";
open F, $file; @msg = <F>; close F;
Send $SERVER, $PORT, $FROM, $SEND_TO, $HELO, \@msg, $MSG_ID;
}
0;
__END__
# smtp-helo.pl ends here
--Multipart_Mon_Aug_24_22:37:52_1998-1--
[
Usenet Hypertext FAQ Archive |
Search Mail Archive |
Authors |
Usenet
]
[
1993 |
1994 |
1995 |
1996 |
1997
]
© Copyright The Internet FAQ Consortium, 1997
All rights reserved