#!/usr/bin/perl
use strict;
use warnings;

my %oberkonfig = (
    cron_errorlog   => 'cron_error.txt',
);

print "Rueckgabe: '".fritz_reconnect(\%oberkonfig)."'\n";
# Rückgaben:
# ==========
# ''                    -> jetzt keine Ausführung, da die aktuelle Stunde nicht $job_konfig{ausfuehrung_um} entspricht
#                          oder die aktuelle IP von heute ist (es wird nur ein Reconnect pro Tag ausgeführt)
# String                -> Fehler aufgetreten, im String steht eine sprechende Fehlermeldung
# String mit Präfix |  -> Auftrag ausgeführt, der String enthält alte und neue Verbindungsdaten
#
# hier im Beispiel soll der Reconnect immer erst durchgeführt werden,
# wenn die aktuelle Stunde auf der Uhr $job_konfig{ausfuehrung_um} entspricht,
# es wird von einem Aufruf per Cronjob in jeder vollen Stunde des Tages ausgegangen

# --------------------------------------------------------------------------------------------------------------
sub systemlog_eintrag {
    # Möglichkeit, in einer Art Protokoll die Verbindungsdaten aufzuzeichnen
    return;
}
# --------------------------------------------------------------------------------------------------------------
sub error {
    print STDERR '['.localtime().'] [error] [MELDUNG JOB '.$_[1].'] '.$_[0]."\n";
}
# --------------------------------------------------------------------------------------------------------------
sub fritz_reconnect {
    #
    # DSL Reconnect der FRITZ!Box per Screenscraping mit Perl nebst WWW::Mechanize und Digest::MD5
    #
    # Getestet mit der FRITZ!Box 7490
    # mit FRITZ!OS 06.30
    # Firmware-Version: 113.06.30
    # im Oktober 2015
    #
    my %job_konfig = (
        ausfuehrung_um          => 4,                                                                           # Stunde des Tages, wann der Reconnect durchgeführt werden soll
        url                     => 'http://fritz.box',
        pass                    => '***',
#       debug                   => 'test_%s.html',                                                              # Dateiname und ggf. Pfad für die Dateien in die die einzelnen Seiten gespeichert werden, %s ist die laufende Nummer, z.B. '/meinpfad/debug_%2.html', nicht definieren, wenn kein Debug erwünscht
        response_reconnect      => 'done:0',                                                                    # was die FRITZ!Box auf "Neu verbinden" zurück liefert
        wait_nach_reconnect     => 20,                                                                          # max. Sekunden Wartezeit nach dem Reconnect zum Abruf der neuen Verbindungsdaten
        verbindungsstatus       => sub {                                                                        # hier den Regex für den Verbindungsstatus pflegen; stattdessen im HTML Baum mit HTML::TreeBuilder rum zu suchen bietet sich hier nicht an
            my ($content,$data) = @_;
            # für FRITZ!OS 6.30:
            if ($$content =~ m~<td><div id='ipv4_title'>Internet, IPv4</div></td><td id='ipv4_led'><div class='led_green'>&nbsp;</div></td><td><div id='ipv4_info'><span class="limited">verbunden seit (\d+).(\d+).(\d+), (\d+):(\d+) Uhr</span>, <span class="limited" style="max-width:240px;">([^<]+)</span><span class="limited">,<br>IP-Adresse: (\d+).(\d+).(\d+).(\d+)</span></div></td>~) {
                $data->{datum} = "$1.$2.$3";
                $data->{zeit} = "$4:$5";
                $data->{provider} = $6;
                $data->{ip4} = "$7.$8.$9.$10";
                $data->{found} = defined;
            }
        },

        # ----- ab hier nichts mehr ändern -----
        fritzbox_hex_md5        => sub {
            # Dank an Jan! https://www.perl-community.de/bat/poard/thread/19845#ms_182588
            my ($string) = @_;
            my @chars = split(//,$$string);
            require Digest::MD5;
            return Digest::MD5::md5_hex(join("\0",@chars)."\0");
        },
        makeDots                => sub {
            my ($str) = @_;
            my $newStr = '';
            my $len = length($str);
            for (my $i = 0; $i < $len; $i ++) {
                my $char = substr($str,$i,1);
                $newStr .= (ord($char) > 255 ? '.' : $char);
            }
            return $newStr;
        },
        write_debug_file        => sub {
            my ($k,$mech,$nr) = @_;
            if (defined $k->{debug}) {
                $$nr ++;
                $$mech->save_content(
                    sprintf($k->{debug},$$nr),
                    binmode             => ':raw',
                    decoded_by_headers  => 1,
                );
            }
        },
    );

    my ($env) = @_;
    my ($back,$content,$g_challenge);
    my @jetzt = localtime(time());
    return '' if $jetzt[2] != $job_konfig{ausfuehrung_um};

    require WWW::Mechanize;
    my $mech = WWW::Mechanize->new(
        agent       => 'Automat',                                                                               # ist der FRITZ!Box egal
        quiet       => 1,                                                                                       # prophylaktisch
        onwarn      => \&{                                                                                      # sollte definiert werden sonst schreibt es bei einer Warnung trotz quiet=>1 auf STDERR
            sub {
                $back = "Warnung '".join('',@_)."'";
                goto FEHLER_UND_RUECKSPRUNG_ZUM_HAUPTPROGRAMM;
            }
        },
        onerror     => \&{                                                                                      # sollte definiert werden sonst schreibt es bei einem Fehler trotz quiet=>1 auf STDERR
            sub {
                $back = "Fehler '".join('',@_)."'";
                goto FEHLER_UND_RUECKSPRUNG_ZUM_HAUPTPROGRAMM;
            }
        },
        stack_depth => 0,                                                                                       # die history Tabelle wird nicht gebraucht, Speicher schonen
    );

    my $debug_nr = 0;
    do {{                                                                                                       # sonst werden die Einrückungen im Code zu breit
        my $dest_url = "$job_konfig{url}/login.lua";

        # Login Formular aufrufen
        $mech->get($dest_url);
        $content = $mech->content();
        if (!defined $content || $content eq '') { $back = "Abruf der Ressource '$dest_url' gescheitert"; last; }

        $job_konfig{write_debug_file}->(\%job_konfig,\$mech,\$debug_nr);
        if ($content =~ /g_challenge( ?)=( ?)"([^"]{8})"/) { $g_challenge = $3; }
        else { $back = "Finde die Variablendefinition zu &gt;g_challenge&lt; nicht"; last; }

        my $form_id = 'uiMainForm';
        my $formular = $mech->form_id($form_id);                                                                # selektiert auch das default Formular obwohl es in der Doku anders steht
        if (!defined $formular) { $back = "Finde das Formular mit der ID '$form_id' nicht"; last; }

        my $temp = $g_challenge.'-'.$job_konfig{makeDots}->($job_konfig{pass});
        my $var_response = $g_challenge.'-'.$job_konfig{fritzbox_hex_md5}->(\$temp);
        my $feldname = 'response';
        $mech->field($feldname,$var_response,1);                                                                # field() liefert leider kein def/undef zurück

        # Login Formular absenden
        if (!$mech->submit()) { $back = "Das Formular mit der ID '$form_id' konnte nicht abgesendet werden"; last; }

        $content = $mech->content();
        if (!defined $content || $content eq '') { $back = "Nach Absenden des Formulars mit der ID '$form_id' wird nichts mehr geliefert"; last; }

        $job_konfig{write_debug_file}->(\%job_konfig,\$mech,\$debug_nr);
        my $link_zu_dsl;
        if ($content =~ /\/internet\/inetstat_monitor\.lua\?sid\=([0-9a-z]+)/) {                                # nutze kein $mech->follow_link(), weil der Link unten nochmal gebraucht wird
            $link_zu_dsl = "$job_konfig{url}/internet/inetstat_monitor.lua?sid=$1";
        }
        else { $back = "Finde den Menüpunkt 'Internet' nicht"; last; }

        # Menüpunkt 'Internet' anklicken
        $mech->get($link_zu_dsl);
        $content = $mech->content();
        if (!defined $content || $content eq '') { $back = "FRITZ!Box liefert im Menüpunkt 'Internet' nichts zurück"; last; }

        $job_konfig{write_debug_file}->(\%job_konfig,\$mech,\$debug_nr);
        my %data;
        $job_konfig{verbindungsstatus}->(\$content,\%{$data{alt}});
        if (!defined $data{alt}{found}) { $back = "Im Menüpunkt 'Online-Monitor' konnte der Verbindungsstatus für 'Internet, IPv4' nicht gefunden werden"; last; }

        if ($data{alt}{datum} eq sprintf('%02d.%02d.%04d',$jetzt[3],$jetzt[4]+1,$jetzt[5]+1900)) { return ''; }

        if ($content =~ /internet\/inetstat_monitor\.lua\?sid=([0-9a-z]+)&useajax=1&action=disconnect/) {
            $dest_url = "$job_konfig{url}/internet/inetstat_monitor.lua?sid=$1&useajax=1&action=disconnect";
        }
        else { $back = "Im Menüpunkt 'Online-Monitor' konnte der Schalter 'Neu verbinden' nicht gefunden werden"; last; }

        # Schalter 'Neu verbinden anklicken'
        my $time_reconnect = time();
        $mech->get($link_zu_dsl.'&useajax=1&action=disconnect');
        $content = $mech->content();
        if (!defined $content || $content eq '') { $back = "Die FRTIZ!Box liefert auf 'Neu verbinden' nichts zurück"; last; }

        $job_konfig{write_debug_file}->(\%job_konfig,\$mech,\$debug_nr);
        if ($content ne $job_konfig{response_reconnect}) { $back = "Der Aufruf 'Neu verbinden' liefert nach disconnect nicht '$job_konfig{response_reconnect}' zurück sondern '$content'"; last; }

        # wieder Menüpunkt 'Internet' aufrufen
        my $start = time();
        while(                                                                                                  # als Schleife, weil das Connect unterschiedlich lange dauert
            (
                !exists $data{neu}
                    ||
                "$data{alt}{datum}$data{alt}{zeit}" eq "$data{neu}{datum}$data{neu}{zeit}"
            )
                &&
            time() - $start < $job_konfig{wait_nach_reconnect}
        ) {
            sleep(2);
            $mech->get($link_zu_dsl);
            $content = $mech->content();
            if (!defined $content || $content eq '') { $back = "FRITZ!Box liefert im Menüpunkt 'Internet' beim zweiten Aufruf nichts zurück"; last; }

            $job_konfig{write_debug_file}->(\%job_konfig,\$mech,\$debug_nr);
            delete $data{neu} if exists $data{neu};
            $job_konfig{verbindungsstatus}->(\$content,\%{$data{neu}});
            if (!defined $data{neu}{found}) { $back = "Nach dem Reconnect konnte im Menüpunkt 'Online-Monitor' der Verbindungsstatus für 'Internet, IPv4' nicht gefunden werden"; last; }
        }
        last if defined $back;

        if ("$data{alt}{datum}$data{alt}{zeit}" eq "$data{neu}{datum}$data{neu}{zeit}") {
            my @t = localtime($time_reconnect);
            $back = "Etwas muss schief gelaufen sein, trotz Reconnect am "
                .sprintf("%02d.%02d.%04d um %02d:%02d Uhr",@t[3..5],$t[2],$t[1])
                ." und einer Wartezeit von "
                .(time() - $start)
                ." Sekunde(n) werden keine neuen Verbindungsdaten ausgegeben, nur die alte IP Adresse $data{alt}{ip4} von $data{alt}{datum} um $data{alt}{zeit} Uhr konnte ermittelt werden"
            ;
            last;
        }

        my $msg = "|Job erledigt, bisherige IP Adresse seit $data{alt}{datum} um $data{alt}{zeit} Uhr lautete"
            ." $data{alt}{ip4}, neue IP Adresse seit $data{neu}{datum} um $data{neu}{zeit} Uhr lautet"
            ." $data{neu}{ip4}"
        ;
        main::systemlog_eintrag(0,1,20,$msg);
        return $msg;

    }} while(0);

    FEHLER_UND_RUECKSPRUNG_ZUM_HAUPTPROGRAMM:
    error($back,87);
    return "Fehler aufgetreten siehe '$env->{cron_errorlog}'";
}