lug-bg: SMS za poluchen E-mail

["Qsin" <qsin@xxxxxxxxxxxx>]

Опитвам се да изпращам SMS при получаване на E-mail.
Системата e Debian woody s Perl 5.6.1 и qmail.
Имам следните 5 файлa:

.qmail
test-procmail.rc
email2sms
.email2smsrc
send_SMS

Когато пусна тест се получава следното съобщение:

Nov 18 18:13:44 mashine qmail: 1069172024.518346 delivery 1191: deferral:

Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_22./
Global_symbol_"_opts"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_32./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_43./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_52./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_53./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_56./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_69./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_70./Global
Nov 18 18:13:44 mashine qmail:
1069172024.518346+_symbol_"$smtp"_requires_explicit_package_name_at_/home/ya
vor/email2sms/send_SMS_line_72./
Global_symbol_"$smtp"_requires_explicit_package_name_at_/home/yavor/email2sm
s/send_SMS_line_75./
Execution_of_/home/yavor/email2sms/send_SMS_aborted_due_to_compilation_error
s./

Явно проблема е в send_SMS затова него съм го показал тук пръв,
но за всеки случай съм дал и останалите файлове.
Да не забравя - Net::SMTP е инсталиран.

Явор Атанасов

----------------------------------------------------------
[root@mashine /home/yavor/email2sms]# more send_SMS
#!/usr/bin/perl -w
#
# Typical script for submitting an SMS message to a WWW gateway
#
# This script requires POST from the Perl LWP package.

my $ServerName = "mail.smtp.bg";

############################################################################
##

use strict;
use Net::SMTP;

my $DEBUG = 1;
if($DEBUG)
{
   $| = 1;
   open(STDERR, ">&STDOUT");
}

        # Create a new SMTP object
        $smtp = Net::SMTP->new($ServerName, Debug => 1);


my $prog = $0;
$prog =~ s!.*/!!;

die <<USAGE if @ARGV or $opts{h};
Usage: $prog [ -d ] [ -o ] < message_file
   -d  Dummy run - send to STDOUT instead of phone
   -o  Show output
USAGE

my $message = join '', <STDIN>;

my $pre_length = length $message;
$message =~ s!([^\w/])!sprintf "%%%02x", ord($1)!eg;
$message =~ s/\s*\n+\s*/ /g;

chomp $message;

        # If you can't connect, don't proceed with the rest of the script
        die "Couldn't connect to server" unless $smtp;

        # Initiate the mail transaction
        # Your "real" email address
        my $MailFrom = "person\@smtp.bg";

        # Recipient's "real" email address
        my $MailTo = "39588xxxxxxx\@sms.mtel.net";

        $smtp->mail( $MailFrom );
        $smtp->to( $MailTo );

        # Start the mail
        $smtp->data();

        # Send the header
        # This address will appear in the message
        #$smtp->datasend("To:  mailing-list\@mydomain.com\n");

        # So will this one
        #$smtp->datasend("From:  MyMailList\@mydomain.com\n");
        #$smtp->datasend("Subject: Test Message\n");
        #$smtp->datasend("\n");

        # Send the body.
        #$smtp->datasend("Hello World!\n\n");
        $smtp->datasend($message);
        $smtp->datasend("\n");
        # Send the termination string
        $smtp->dataend();

        # Close the connection
        $smtp->quit();

# Quote characters which won't get through the gateway otherwise
#my $pre_length = length $message;
#$message =~ s!([^\w/])!sprintf "%%%02x", ord($1)!eg;
#$message =~ s/\s*\n+\s*/ /g;
----------------------------------------------------------
[root@mashine /home/yavor]# more .qmail
|preline /usr/bin/procmail -m -p test-procmail.rc
----------------------------------------------------------
[root@mail /home/yavor]# more test-procmail.rc
:0 c
mail
:0 ic
| cd mail && rm -f dummy `ls -t msg.* | sed -e 1,32d`
:0 c
| email2sms | /home/yavor/email2sms/send_SMS
----------------------------------------------------------
[root@mashine /home/yavor/email2sms]# more email2sms
#!/usr/bin/perl -w
##
## email2sms - email to SMS formatter
##
## Copyright (c) 1999--2000 Adam Spiers <adam@xxxxxxxxxx>.
## Miniscule portions Copyright (c) 1999 Ry4an Brase <ry4an@xxxxxxxxx>.
##
## All rights reserved. This program is free software; you can redistribute
## it and/or modify it under the same terms as Perl itself.
##
## $Id$
##


use strict;

use Lingua::EN::Squeeze;
use MIME::Entity;
use MIME::Body;
use MIME::Parser;
use Getopt::Std;


##
## Process options and config file
##

my %opts = ();
getopts('f:h', \%opts);

my $configfile = $opts{'f'} || "$ENV{HOME}/.email2smsrc";

if (@ARGV or $opts{h}) {
  die <<USAGE;
email2sms, (c) 1999 Adam Spiers <adam\@spiers.net>

Command-line usage: email2sms [ -f configfile ] < email_in > sms_out

Please see the accompanying README/INSTALL files for full instructions.
USAGE
}

# Configuration defaults
my %conf = (
            maxlen  => 160,
            logfile => '',
            section => '|',
            newline => '|',
            attrib  => '',
            quoted  => '',
            squeeze_modes => [ 'noconv' ],
            optimize => 0,
            respond => 0,
            smtphost => 'localhost',
           );

&parse_config_file($configfile);

# Open log file
if ($conf{logfile}) {
  open(LOG, ">>$conf{logfile}")
    or die "Couldn't open log file $conf{logfile} for appending.\n";
}


##
## Parse and munge e-mail
##

# FIXME: This is a security hole!
my $tmp_dir = "/tmp/email2sms.$>.$$";

&log_this("Using $tmp_dir as MIME temporary directory\n");
mkdir $tmp_dir, 0700 or die "mkdir: $!";
my $parser  = new MIME::Parser;
$parser->output_dir($tmp_dir);

my $mail_in = $parser->read(\*STDIN)
  or die "Couldn't parse STDIN as MIME stream\n";

my $body_in = join '', @{ body $mail_in };

my $why_not = &check_content_type($mail_in);
die "$why_not\n" if $why_not;

# These globals are our scratchpad, and get used by &final_out()
my ($from_in, $from_out, $subject_out, $body_out);

# Munge body first
$body_out = $body_in;
&munge_body($body_in);

# Then munge header, depending on how much we managed to squeeze the body
my $header_in = head $mail_in;
my $header_out = &munge_header($header_in);


##
## Send message
##

my $sms = substr(&final_out, 0, $conf{maxlen});

&log_this("Final message:\n$sms\n");
&log_delim();
&log_this("Final length: ", length($sms), "\n");

if ($conf{respond}) {
  my $matched = eval qq{\$from_in =~ $conf{respond}};
  if ($@) {
    &log_delim();
    &log_this("`respond' regexp $conf{respond} didn't compile:\n  $@\n");
  }
  elsif ($matched) {
    &log_delim();
    &respond($mail_in);
  }
  else {
    &log_delim();
    &log_this("didn't match respond regexp\n");
  }
}

&log_delim('-');

print $sms, "\n";

my $all_tmps = "$tmp_dir/*";
unlink glob($all_tmps) or die "unlink: $!";
rmdir $tmp_dir;

exit 0;


############################################################################
##

sub parse_config_file {
  my $config_file = shift;

  open(CONFIG, $config_file)
    or die "Couldn't open config file $config_file: $!\n";
  while (<CONFIG>) {
    next if /^\s*\#/ || /^\s*$/;           # damn cperl-mode

    s/^\s*//;                   # trim leading whitespace

    # This is a butt-ugly switch
    if (/^maxlen\s+(\d+)/) {
      $conf{maxlen} = $1;
    }
    elsif (/^logfile\s+(.*?)\s*$/) {
      ($conf{logfile} = $1) =~ s/~/$ENV{HOME}/g;
      $conf{logfile} =~ s/\$(\w)/$ENV{$1}/g;
    }
    elsif (/^section\s+'(.*)'\s*$/) {
      $conf{section} = $1;
    }
    elsif (/^newline\s+'(.*)'\s*$/) {
      $conf{newline} = $1;
    }
    elsif (/^attrib\s+'(.*)'\s*$/) {
      $conf{attrib} = $1;
    }
    elsif (/^quoted\s+'(.*)'\s*$/) {
      $conf{quoted} = $1;
    }
    elsif (/^fromsub\s+(.*)$/) {
      push @{$conf{from_substs}}, $1;
    }
    elsif (/^squeeze\s+(.*)\s*$/) {
      @{$conf{squeeze_modes}} = split /,\s*/, $1;
    }
    elsif (/^optimize\s+([01])\s*$/) {
      $conf{optimize} = $1;
    }
    elsif (/^respond\s+(.*)\s*$/) {
      $conf{respond} = $1;
    }
    elsif (/^response-from\s+(.*)\s*$/) {
      $conf{response_from} = $1;
    }
    elsif (/^smtphost\s+(.*)\s*$/) {
      $conf{smtphost} = $1;
    }
  }
  close(CONFIG);
}

##

sub check_content_type {
  my ($mail_in) = @_;

  my $why_not = '';

  my $content_type = $mail_in->mime_type;
  &log_this("Content-Type is $content_type\n");

  if ($mail_in->is_multipart) {
    &log_this("Message is multipart; splitting ...\n");

    # Get text/plain bits only
    my @parts = $mail_in->parts;
    &log_this(@parts . " parts found\n");

    if (@parts > 0) {
      my @parts_in = ();
      foreach my $part (@parts) {
        my $mime_type = $part->mime_type;
        &log_this("part type $mime_type\n");
        if ($mime_type =~ m!^text/plain!i) {
          push @parts_in, $part->body_as_string();
        }
        else {
          &log_this("Skipping $mime_type attachment\n");
        }
      }
      if (@parts_in) {
        $body_in = join $conf{section}, @parts_in;
      }
      else {
        $why_not = "No text/plain message parts found.";
      }
    }
    else {
      $why_not = "Multipart message had no parts.";
    }
  }

  &log_delim();

  return $why_not;
}

##

sub munge_body {
  my ($body_in) = @_;

  #&log_this("*** Untouched message body:\n$body_in\n");
  #&log_delim();

  # Remove quoted material
  #$body_in =~ s/(^> *.*?$()\n)+//gm;
  $body_in =~ s/
                ( $conf{attrib} \n ) ?           # attribution line
                ( $conf{quoted} .*? $ \n )+      # quoted lines
               //gmx
    if exists $conf{attrib} and exists $conf{quoted};

  &log_this("*** Dequoted message body:\n$body_in\n");
  &log_delim();

  # Newlines collapse ...
  $body_in =~ s/^\n+\s*//;
  $body_in =~ s/\s*\n+\s*/$conf{newline}/g;

  my $mode = 0;
  my @squeeze_modes = @{$conf{squeeze_modes}};
  $Lingua::EN::Squeeze::SQZ_OPTIMIZE_LEVEL = $conf{optimize};

  # Shrink body, but not more than necessary

  do {
    my $new_mode = $squeeze_modes[$mode++];
    &log_this("Trying squeeze mode $new_mode on body ... ");
    SqueezeControl($new_mode);

    $body_out = SqueezeText $body_in;

    # SqueezeText seems to add a \n
    chomp $body_out;

    # It doesn't eliminate multiple consecutive spaces either ... weird
    $body_out =~ s/\s+/ /g;

    &log_this(length(&final_out) . " characters\n");
  }
  until length(&final_out) <= $conf{maxlen} or $mode > $#squeeze_modes;

  &log_delim();
}

##

sub munge_header {
  my ($header_in) = @_;

  # Who's it from?
  $from_in = $header_in->get('From') || $header_in->get('From ') || '?';
  $from_in =~ s/\w{3} \w{3} \d\d \d\d:\d\d:\d\d \d{4}$//; # remove date

  $from_out = $from_in || '?';

  # Eliminate multiple consecutive spaces
  $from_out =~ s/\s+/ /g;

  if ($from_out) {
    chomp $from_out;
    &munge_from();
  }

  my $subject_in = $header_in->get('Subject') || '';
  chomp $subject_in;
  &munge_subject($subject_in) if $subject_in;
}

##

sub munge_from {
  return unless @{$conf{from_substs}};

  my $munger_code = <<'EVAL';
sub {
  my $from = shift;

EVAL

  $munger_code .= join '',
                       map { '  $from =~ ' . $_ . ";\n" }
                           @{$conf{from_substs}};
  $munger_code .= <<'EVAL';
  return $from;
}
EVAL

  &log_this("from munger is:\n$munger_code");
  &log_delim();
  my $munger = eval $munger_code;

  &log_this("From header before munging is $from_out\n");
  $from_out = $munger->($from_out);
  &log_this("From header after munging is $from_out\n");
  &log_delim();
}

##

sub munge_subject {
  my ($subject_in) = @_;

  # Shrink subject if we're still over the limit, but not more than
necessary

  $subject_out = $subject_in;

  if (length(&final_out) > $conf{maxlen}) {
    my $mode = 0;
    my @squeeze_modes = @{$conf{squeeze_modes}};
    do {
      my $new_mode = $squeeze_modes[$mode++];
      &log_this("Trying squeeze mode $new_mode on subject ... ");
      SqueezeControl($new_mode);

      $subject_out = SqueezeText $subject_in;

      # SqueezeText seems to add a \n
      chomp $subject_out;

      # It doesn't eliminate multiple consecutive spaces either ... weird
      $subject_out =~ s/\s+/ /g;

      &log_this(length(&final_out) . " characters\n");
    }
    until length(&final_out) <= $conf{maxlen} or $mode > $#squeeze_modes;

    &log_delim();
  }
}

##

sub final_out {
  my @sections = ();

  foreach ($from_out, $subject_out, $body_out) {
    my $section = $_;           # stop aliasing effect
    if ($section) {
      # damnit, thought this would have gone by now
      $section =~ s/^\s*(.+?)\s*$/$1/;
      push @sections, $section;
    }
  }

  return join $conf{section}, @sections;
}

##

sub log_this {
  return unless $conf{logfile};

  print LOG @_;
}

##

sub log_delim {
  my $delimiter = shift;
  $delimiter ||= '. ';
  &log_this(substr($delimiter x 80, 0, 79), "\n");
}

##

sub respond {
  my $mail = shift;

  # Mail::Util looks at $MAILADDRESS when Mail::Internet is deciding
  # what the From header should be.
  #
  # N.B. This next line causes the debugger on some Perls to SEGV!
  $ENV{'MAILADDRESS'} = $conf{response_from};

  my $reply;
  {
    # Avoid stupid warnings in Mail::Internet
    local $^W = 0;
    $reply = $mail->reply();
  }

  my $to = $reply->head->get('To');
  chomp $to;
  &log_this("Responding by email to: $to\n");

  my $body = <<EOF;
THIS IS AN AUTOMATICALLY GENERATED MESSAGE:

Your message has been converted for display on a device capable of
receiving SMS messages.  The converted output appears below.  If you
believe that information vital to the understanding of the message
has been truncated or lost during compression please shorten your
message or split it into multiple messages and resend it.

Message sent to SMS device:

EOF

  $body .= substr(&final_out, 0, $conf{maxlen});

  # Set the body
  my $body_handle = new MIME::Body::Scalar $body;
  $reply->bodyhandle($body_handle);

  # Send the autoreply
  my @sent_to = $reply->smtpsend(Host => $conf{smtphost})
    or warn "failed to send auto-reply";
----------------------------------------------------------
[root@mashine /home/yavor]# more .email2smsrc
##
## Configuration file for email2sms
##

# Maximum number of characters in output.
# Remember, this should be /less/ than 160 if your SMS gateway adds
# text to the message during sending.
maxlen 160

# Name of file to log to (~ and $ environment interpolation work)
# If no file is specified, no logging will occur
logfile ~/.email2sms.log

# Delimiter for From header, Subject header, and body
section '$'

# Replace all new lines with this delimiter
newline '$'

# Perl regular expressions to match attribution and quoted lines
# N.B. Both must be defined for either to have any effect
attrib '^.*?\s+(wrote|writes):\s*$'
quoted '^\s*[}>]\s*'

#
# Perl substitutions to perform on From header
# (these get eval()ed - careful!)
#

fromsub s/\s*"?(.*?)"?\s+<.*>\s*/$1/
fromsub s/\.uk$//
fromsub s/\.\w+$//

# Define which squeeze modes to try in turn in an attempt to get
# the message smaller than maxlen characters.
# Comment this out for no compression:
squeeze noconv, conv, med, max

# Decide squeeze optimization level.  Choose either 0 or 1.  1
# improves compression by an average of 10%, but the text is maybe
# harder to read (although personally I don't find it noticeably
# harder).
optimize 1

# If this regexp matches the sender, let see them see what their
# message was sent as via an email response.
#
# If it's undefined, the response will never be sent.  If it's //, it
# will match any sender, and so send a response every time.
#respond /adam-respond-test/

# From address to use when sending the auto-response.  This is only
# needed if a response might be sent.
#response-from my-autoreply@xxxxxxxxxxxxx

# SMTP host to use for sending the auto-response.  This is only needed
# if a response might be sent.
#smtphost localhost

============================================================================
A mail-list of Linux Users Group - Bulgaria (bulgarian linuxers).
http://www.linux-bulgaria.org - Hosted by Internet Group Ltd. - Stara Zagora
To unsubscribe: http://www.linux-bulgaria.org/public/mail_list.html
============================================================================