#!/usr/bin/perl -w

use 5.006;
use strict;
use warnings;

use Getopt::Long qw(GetOptions);
use noris::NetSaint;

my $Match;
GetOptions(
    'fillin=s%'     => \my %FillIn,
    'formnumber=i'  => \my $FormNumber,
    'match=s'       => sub { $Match = qr/$_[1]/ },
    'plugin=s'      => \( my $Plugin = 'noris::Nagios::WebLogin::Agent' ),
    'start-url=s'   => \my $StartUrl,
    'help|?' => sub {
        exec perldoc => -F => $0
          or die qq(Cannot execute "perldoc -F $0": $!\n);
    },
  )
  or exit 1;

eval "require $Plugin";
die "$@" if length $@;

my $NetSaint = noris::NetSaint->new;

die "Überflüssige Argumente auf der Kommandozeile: @ARGV\n" if @ARGV;
die "Es muss eine -start-url angegeben werden.\n" unless defined $StartUrl;

my $agent = $Plugin->new( onerror => sub { die "$Plugin-Fehler: @_" } );

{    # "Parsing of undecoded UTF-8 will give garbage when decoding entities":
    local $^W;
    $agent->get($StartUrl);
}

die "Der Aufruf der Startseite <$StartUrl> schlug fehl: "
  . $agent->response->status_line . "\n"
  unless $agent->success;

my %ExtraOptions = ( defined $FormNumber ? ( form_number => $FormNumber ) : () );
$agent->submit_form( %ExtraOptions, fields => \%FillIn );
die 'Fehler auf '
  . $agent->uri
  . ' nach dem Ausfüllen des Formulars: '
  . $agent->response->status_line . "\n"
  unless $agent->success;

# für Zarafa:
if ( defined( my $refresh_header = $agent->response->header('Refresh') ) ) {
    my $uri = $agent->uri;
    $refresh_header =~ /^\s*(\d+)\s*;\s*url=(.*?)\s*$/i
      or die
      "Unbekannte Syntax im Refresh:-Header auf <$uri>: $refresh_header\n";
    sleep $1;
    $agent->get($2);
    die "Fehler nach zusaetzlichem GET <$2> aufgrund eines Refresh:-Headers: "
      . $agent->response->status_line . "\n"
      unless $agent->success;
}

my ( $status, $message ) =
    defined $Match
  ? $agent->content =~ $Match
  ? ( OK => '' )
  : ( Critical => ' nicht' )
  : ( OK       => ' anscheinend' );
$NetSaint->update(
    $status => "Der Login-Versuch war$message erfolgreich und fuehrte zur URL <"
      . $agent->uri
      . '>' );

$agent->logout;

__END__

=head1 NAME

check_weblogin - Nagios-Plugin für Logins via Web-Formulare

=head1 SYNOPSE

    check_weblogin -start-url https://webmail.haspa-direkt.de/  \
                   -formnumber 2                                \
                   -fillin username=testuser                    \
                   -fillin password=********                    \
                   -match '"noris network AG Monitor Account"'  \
                   -plugin "noris::Nagios::WebLogin::Plugin::..."

=head1 BESCHREIBUNG

Das Plugin ruft die angegebene L</-start-url> auf, füllt dort ins erstbeste
E<lt>FORME<gt>ular mit den mit L</-fillin> angegebenen Werten aus und schickt es
ab.
Optional schaut es nach, ob der Inhalt der Seite, auf der es anschließend
landet, zum bei L</-match> angegebenen regulären Ausdruck passt.
Falls gewünscht kann anschließend ein Logout durchgeführt werden. Dazu muss ein
Codeblock nach dem Logout angegeben werden der dann auch ausgeführt wird.

=head1 NOTWENDIGE ARGUMENTE

=over 4

=item -start-url URL

URL, bei der begonnen werden soll;
dort muss mindestens ein Web-Formular enthalten sein.

=back

=head1 OPTIONEN

=over 4

=item -fillin Name=Wert

füllt das E<lt>FORME<gt>ular des angegebenen C<Name>ns mit dem angegebenen
C<Wert> aus

=item -match RegExp

überprüft, ob die Seite, die nach dem Absenden des ausgefüllten Formulars
zurückgeliefert wird, zum angegebenen regulären Ausdruck passt.

=item -plugin Perl-Module

über Plugin kann man eigene Plugins laden, die speziell auf die jeweilige
Webseite angepasste Funktionen haben.

Beispiel: C<"noris::Nagios::WebLogin::Plugin::Projectile">

Default: C<"noris::Nagios::WebLogin::Agent">

=item -formnumber No

Für den Fall das nicht das erste Formular angesprochen werden soll kann
mann über formnumber die Formularnummer angeben die gefüllt und gesendet
werden soll.

=item -help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 FEHLERSTATUSSE

Wenn irgendwas schiefgeht, wird ein C<Critical> gemeldet.

=head1 AUTOR

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

