#!/usr/bin/perl -Tw

use strict;
use utf8;
use warnings;

# $Id: sms,v 1.9 2009/03/13 13:12:59 fany Exp $

use Encode qw(decode);
use Fcntl qw(O_APPEND O_CREAT O_WRONLY);
use FindBin ();
use Getopt::Long qw(GetOptions :config posix_default);
use Mail::Address ();
use MIME::Parser  ();
use lib do { $FindBin::Bin =~ /^(.*)/; $1 };
use noris::SMS qw(normalize_numbers);

use constant {
    EXIT_OK       => 0,
    EXIT_TEMPFAIL => 75,
    EXIT_HARDFAIL => 77,    # not verified
};
use constant DEFAULT_PASSWORD_HEADER => map "X-noris-SMSGW-Passwor$_", qw(d t);
use constant DEFAULT_SOURCE_HEADER => 'X-noris-SMSGW-Source';
use constant DEFAULT_USER_HEADER => ( 'X-noris-SMSGW-User', '' );

our $Exit_Code = EXIT_TEMPFAIL;

/^(.*)/s and $_ = $1 for @ARGV;    # untaint commandline

our %Debug;
GetOptions(
    'acctfile=s'     => \our $AcctFile,
    'authuserfile=s' => \our $AuthUserFile,
    'debug:s' =>
      sub { ( undef, my $arg ) = @_; ++$Debug{ defined $arg && $arg } },
    'help|?'         => sub {
        $ENV{PATH} =~ /^(.*)/ and $ENV{PATH} = $1;
        $0 =~ /^(.+)/ or die;
        exec qw(perldoc -F) => $1 or die "Cannot execute perldoc: $!\n";
    },
    'logfile=s'       => \our $Logfile,
    'max-sms=i'       => \our $Max_SMS,
    'password-header' => \our @Password_Header,
    'scan-body!'      => \( our $Scan_Body = 1 ),
    'source-header=s' => \our @Source_Header,
    'maxparts=i'      => \( our $MaxParts = 1 ),
    'test!'           => \( our $Test = 0 ),
    'timeout=i'       => \( our $Timeout = 42 ),
    'url=s'           => \our @URLs,
    'user-header'     => \our @User_Header,
) or exit 1;

@Source_Header   = DEFAULT_SOURCE_HEADER   unless @Source_Header;
@User_Header     = DEFAULT_USER_HEADER     unless @User_Header;
@Password_Header = DEFAULT_PASSWORD_HEADER unless @Password_Header;

{
    my $log_fh = \*STDERR if !defined $Logfile && -t STDERR;

    sub note {
        return unless $log_fh || defined $Logfile;
        sysopen $log_fh, $Logfile, O_APPEND | O_CREAT | O_WRONLY
          or die qq(Cannot open logfile "$Logfile" in append mode: $!\n)
          unless $log_fh;

        chomp( my $msg = ref $_[0] ? $_[0]->() : "@_" );
        $msg =~ y/\n/ /s;
        print $log_fh localtime() . " [$$] $msg\n";
    }
}

$SIG{__WARN__} = \&note;
$SIG{__DIE__} = sub { note @_; die @_ };

sub abort {
    note "ABORT: @_";
    print STDERR @_;
    exit( $Exit_Code = EXIT_HARDFAIL );
}

sub debug($$) {
    my ( $category, $message ) = @_;
    note($message) if $Debug{$category} || $Debug{''};
}

# Workaround für sporadisch auftretenden Bug, vgl. RT#542388-41:
sub my_chomp($) { $_[0] =~ s/\s+\z// }

die "USAGE: $0 <sender> <rcpt>+\n" if @ARGV < 2;

note "Called: @ARGV";

my $sender = shift;

my @rcpt;
for (@ARGV) {
    my ($address) = Mail::Address->parse($_)
      or die qq(Cannot parse mail address <$_>.\n);
    defined( my $rcpt = $address->user )
      or die qq(Cannot find user part in <$_>.\n");
    push @rcpt, normalize_numbers $rcpt;
}

my $parser = new MIME::Parser or die "Cannot create MIME::Parser object.\n";
$parser->tmp_to_core(1);
$parser->output_to_core(1);

my $entity = $parser->parse( \*STDIN ) or abort "Cannot parse this message.\n";
my $header = $entity->head;

my $msg;
if ( my @parse_what = map { get_decoded( $header, $_ ) } @Source_Header ) {
    my @sm_msg_parts;
    for my $msg_parts (@parse_what) {
        if ( $msg_parts =~ m/\// ) {
            my @todo = $entity;
            while (@todo) {
                if ( my @parts = ( my $entity = shift @todo )->parts ) {
                    unshift @todo, @parts;
                }
                elsif ( !defined( my $mime_type = $entity->mime_type ) ) {
                    warn "Cannot detect MIME type.\n";
                }
                elsif ( $mime_type eq $msg_parts ) {
                    my $body = get_body_as_string($entity);
                    push @sm_msg_parts, $body;
                }
            }
        }
        else {
            push @sm_msg_parts, get_decoded( $header, $msg_parts );
        }
    }

    $msg = join( "\n", @sm_msg_parts );
}
else {    # Default-Verhalten
    $entity = $entity->parts(0) while $entity->parts;

    $msg = get_body_as_string($entity);
}

my $kunde = '';

if ( defined $AuthUserFile ) {

    my $user;
    for (@User_Header) {
        next unless length;
        defined( $user = $header->get($_) ) or next;
        my_chomp($user);
        debug( auth => qq(Found user "$user" in header "$_".) );
        last;
    }
    if ( !defined $user && $Scan_Body ) {
        for (@User_Header) {
            next unless length;
            $msg =~ s/^\Q$_\E:\s*(\S+)[^\S\n]*\n?//m or next;
            $user = $1;
            debug( auth => qq(Found user "$user" in body, tag "$_".) );
            last;
        }
    }
    if ( !defined $user && grep !length, @User_Header ) {
        $user = $header->get('From') or next;
        my_chomp($user);
        my ($address) = Mail::Address->parse($user)
          or die qq(Cannot create Mail::Address object for "$user".\n);
        defined( my $a = $address->address )
          or die qq(Cannot find address part in "$address".\n);
        $user = $a;
        debug( auth => qq(Took user "$user" from header "From:".) );
    }

    my $password;
    for (@Password_Header) {
        defined( $password = $header->get($_) ) or next;
        my_chomp($password);
        debug( auth => qq(Found password "$password" in header "$_".) );
        last;
    }

    if ( !defined $password && $Scan_Body ) {
        for (@Password_Header) {
            $msg =~ s/^\Q$_\E:\s*(\S+)[^\S\n]*\n?//m or next;
            $password = $1;
            debug( auth => qq(Found password "password" in body, tag "$_".) );
            last;
        }
    }

    defined and chomp for $user, $password;

  AUTH: for (undef) {
        open my $fh, '<', $AuthUserFile
          or die
          qq(Cannot open password file "$AuthUserFile" for reading: $!\n);

      USER: while ( defined( my $line = <$fh> ) ) {
            next if $line =~ /^\s*#/ || $line !~ /\S/;
            ( $kunde, my $u, my $p, my @prefixes ) = split ' ', $line;

            unless ($u eq '-' || defined $user && $u eq $user
                and $p eq '-'
                || defined $password
                && ( $p eq $password || $p eq crypt $password, $p ) )
            {
                debug( auth => qq(Rule did not match: $line) );
                next;
            }

            if (@prefixes) {
                y/-//d for @prefixes;
                for my $rcpt (@rcpt) {
                    last if grep substr( $rcpt, 0, length ) eq $_, @prefixes;
                    debug( auth => qq(Prefixes did not match: $line) );
                    next USER;
                }
            }
            note "Authenticated by rule: $line";
            last AUTH;
        }
        abort qq(Authorization required for sending short messages to @rcpt.\n);
    }
}

my $sms;
{
    my @noris_sms_args = (
        debug    => $Debug{backend} || $Debug{''},
        dest     => \@rcpt,
        max_sms  => $Max_SMS,
        maxparts => $MaxParts,
        data     => $msg,
        test     => $Test,
        timeout  => $Timeout,
        @URLs ? ( urls => \@URLs ) : ()
    );
    note( sub { 'Calling noris::SMS with ' . pp( {@noris_sms_args} ) } );
    $sms = noris::SMS->new(@noris_sms_args)
      or die "Cannot create noris::SMS object.\n";
}

unless ( my $result = $sms->send ) { abort "$result\n" }
elsif ( defined $AcctFile ) {
    unless ( sysopen my $fh, $AcctFile, O_APPEND | O_CREAT | O_WRONLY ) {
        warn
          qq(Cannot open accounting logfile "$AcctFile" in append mode: $!\n);
    }
    else {
        print $fh join ( "\t", time, $result->sent, $kunde, $sender, @rcpt )
          . "\n";
    }
}

$Exit_Code = EXIT_OK;

END { $? = $Exit_Code }

sub pp {
    local $^W;
    require Data::Dump and Data::Dump->import('pp');
    goto &pp;
}

sub get_decoded {
    my ( $mime_head, $header_name ) = @_;
    my @header_content = $mime_head->get_all($header_name);
    return () unless @header_content;

    my @retval = map { chomp; decode( 'MIME-Header', $_ ); } @header_content;
}

sub get_body_as_string {
    my $entity = shift;

    # modulspezifische Änderungen des Bodys:
    my $encoding = $entity->head->mime_attr('content-type.charset');

    $encoding = 'ascii' unless defined $encoding;

    my $body =
      decode( $encoding, ( my $bodyhandle = $entity->bodyhandle )->as_string )
      or die "Cannot extract message from mail using bodyhandle.\n";

    $body;
}

__END__

=encoding utf8

=head1 NAME

mail2sms - sendet eine Nachricht via HTTPS an das Brodos Mail->SMS-Gateway

=head1 AUFRUFSYNTAX

    mail2sms [OPTIONEN] <Absender> <Empfaenger>+

=head1 BESCHREIBUNG

Das Script erwartet eine E-Mail auf der Standardeingabe und verwandelt Teile
davon in SMs für die angegebenen Zielrufnummern.

Welche Teile, kann im L<Header|/-source-header HEADERNAME> festgelegt werden,
der bei Bedarf mehrfach verwendet kann, wenn mehrere Teile der E-Mail
berücksichtigt werden sollen.

Beispiel:

	X-noris-SMSGW-Source: Subject
	X-noris-SMSGW-Source: text/plain

Bedeutet: das Subject und alle C<text/plain>-Teile der E-Mail werden für die
SM berücksichtigt.

Grundsätzlich sind folgende Angaben ("Tokens") möglich:

=over 4

=item I<Headername>

der Inhalt des/der Header mit dem angegebenen Namen

=item I<MIME-Type>

alle Teile mit dem angegebenen MIME-Typ

=back

Zum Zusammenbauen des Texts für die SMs werden die Tokens in der angegebenen
Reihenfolge abgearbeitet, d. h. die E-Mail wird jeweils nach einschlägigen
Bestandteilen durchsucht, die ggf. aneinandergehängt werden, wobei zwischen
den einzelnen Bestandteilen Zeilenumbrüche eingefügt werden.

Wird im Header nichts angegeben, so wird der erste MIME-Teil, der einen Body
hat, für die SMs verwendet.
(Das ist das teils historisch bedingte Default-Verhalten des Programms.)

Die Ziel-Rufnummern werden aus den auf der Kommandozeile angegebenen
Empfaenger-E-Mail-Adressen ermittelt, wobei der Domain-Teil ignoriert und der
User-Teil als Telefonnummer interpretiert wird, wobei folgende Regeln gelten:

=over 4

=item *

Beginnt die Rufnummer mit mindestens zwei Nullen, so werden diese verworfen.

=item *

Beginnt die Rufnummer mit nur einer Null, so wird diese durch "49" ersetzt.

=item *

Sodann werden alle nicht-numerischen Zeichen entfernt.

=item *

Schließlich wird ein Pluszeichen vorangestellt.

=back

=head1 OPTIONEN

=over 4

=item -authuserfile DATEINAME

Gibt den Namen einer Datei an, die zeilenweise durch Whitespace getrennt
Kundennamen (diese werden hier eigentlich nicht benötigt, außer um sie ggf.
ins L</-acctfile> zu schreiben), Usernamen (bzw. Mail-Adressen, vgl.
L</-user-header>), zugehörige Passwörter und in weiteren Spalten optional
Nummern-Präfixe enthält.

Wird dieser Parameter angegeben, ist die Benutzung des Gateways nur bei Angabe
einer passenden User/Passwort-Kombination (vgl. L</-user-header> und
L</-password-header>) erlaubt.

Enthält ein Eintrag in der Datei Nummern-Präfixe, darf der jeweilige User nur
SMs an Rufnummern versenden, die - in der vereinheitlichten Form - mit einem
dieser Präfixe beginnen.

Nur aus Whitespace bestehende oder ganz leere Zeilen werden übersprungen,
ebenso solche, die mit (optionalem Whitespace und) Hashmarks beginnen.

Als Sonderfall kann an Stelle von Username und/oder Passwort ein Bindestrich
angegeben werden, um beliebige (bzw. auch keine) Usernamen bzw. Passwörter
zuzulassen.

Bindestriche können auch zur übersichtlicheren Grupperung der
Rufnummern(-Prefixes) verwendet werden.

Beispiel für den Aufbau der Datei:

	POP	cosmo	Daniela	+4917 +39
	POP	fany	P3r1
	POP	-	-	+49-170-7935715

In diesem Beispiel dürfte der Benutzer "cosmo" mit sPasswort "Daniela" nur SMs
an T-D1-Rufnummern sowie nach Italien versenden, der Benutzer "fany" mit
sPasswort "P3r1" hingegen SMs an beliebige Zielrufnummern, und an die Rufnummer
+49-170-7935715 darf jeder SMs schicken.

=item -help 

=item -?

Zeigt (nur) die Dokumentation an.

=item -logfile DATEINAME

Wird dieser Parameter angegeben, hängt das Script Statusmeldungen an die
angegebene Datei an, die dazu ggf. auch neu erzeugt wird.

Wird kein Logfile angegeben, werden dieselben Meldungen auf STDERR ausgegeben,
sofern STDERR auf ein Terminal zeigt.

=item -acctfile DATEINAME

Wird dieser Parameter angegeben, hängt das Script für jede versandte SM eine
Zeile an die angegebene Datei mit folgenden, durch TABs getrennten Werten an:

 1. Unix-Timestamp
 2. Anzahl der versandten SMs
 3. Wert der ersten Spalte des verwendeten Eintrags aus dem -authuserfile
    (üblicherweise ist das der Kundenname)
 4. Envelope-Absender-Adresse der E-Mail
 5. (und ggf. weitere) Zielrufnummern im vereinheitlichten Format

Gedacht ist das fürs Accounting.

=item -debug TEILGEBIET

Aktiviert die Ausgabe zusätzlicher Debug-Meldungen (ins L</-logfile>) für
Unterstützte Teilgebiete sind "auth", "backend" und "" (= alles).

=item -test

Bei der verwendung der Parameters Test, wird zwar eine HTTP-Anfrage an den
Anbieter gesendet, aber seinerseits werden keine SMs verschickt.

=item -max-sms ANZAHL

Legt die Höchstanzahl der SMs fest, die insgesamt (an alle Zielrufnummern)
aus der Mail erzeugt werden sollen.
Falls zu niedrig gesetzt kann es passieren dass manche Teilnehmer keine
SMs erhalten.

Default: unbegrenzt

=item -password-header HEADERNAME

Legt den oder die Namen des/der Header fest, in dem/denen das Passwort angegeben
sein muss, das zur Benutzung des Gateways berechtigt.
(Kann mehrfach angegeben werden.)

Default: C<X-noris-SMSGW-Password> und C<X-noris-SMSGW-Passwort>

=item -scan-body / -noscan-body

Legt fest, ob hilfsweise (wenn keine entsprechenden Header gefunden wurden) im
ersten MIME-Teils des Mail-Bodies nach Angaben fuer Username und Passwort
gesucht werden soll; diese müssen dort ggf. ebenfalls in der Form

	HEADERNAME: INHALT

auf einer eigenen Zeile angegeben werden; wird ein solcher Eintrag zur
Authentifizierung genutzt, wird er vor dem Versand der SMs aus dem Body
entfernt.

=item -source-header HEADERNAME

Legt den oder die Namen des/der Header fst, in dem/denen angegeben
werden kann, welche Teile der E-Mail für die SM(s) verwendet werden
sollen.

Default: C<X-noris-SMSGW-Source>

=item -maxparts ANZAHL

Legt die Höchstanzahl der SMs fest, die pro Ziel-Rufnummer aus der Mail erzeugt
werden sollen.

Default: 1

=item -timeout SEKUNDEN

Setzt den L<LWP::UserAgent>-Timeout für die HTTP(S)-Abfrage.

=item -user-header HEADERNAME

Legt den oder die Namen des/der Header fest, in dem/denen der Username angegeben
sein muss, das zur Benutzung des Gateways berechtigt.
Bei Angabe eines leeren Strings als Argument wird auf die im From:-Header
angegebene Mail-Adresse zurückgegriffen, dies allerdings erst nach einem
vergeblichen Durchsuchen des Mail-Bodies, sofern L<-scan-body|/-scan-body /
-noscan-body> aktiv ist.
(Kann mehrfach angegeben werden.)

Default: C<X-noris-SMSGW-User>

=item -url URL

Hier kann eine alternative URL angegeben werden, unter der das SMS-Gateway
erreichbar ist.
Dieser Parameter kann mehrfach angegeben werden; die URLs werden dann der Reihe
nach durchprobiert, bis die SM irgendwo erfolgreich abgesetzt werden konnte.

=back

=head1 FEHLER

Das Script beendet sich mit Status OK, sobald mindestens eine SM erfolgreich
zugestellt werden konnte (auch, wenn diese in mehrere Teile zerlegt wurde und
das nicht für alle Teile gilt).
Es wird daher empfohlen, pro Aufruf nur eine Zielrufnummer zu übergeben.

=head1 AUTOR

 Martin H. Sluka <fany@noris.net>
 für die noris network AG

=cut

