www

lan4lano.de

SSDP_discover.pl

Date : 07/01/2019


#!/usr/bin/perl 

use Socket;

$IP             = "239.255.255.250";
$PORT           = 1900;
$TIMEOUT        = 3;

$request_header = <<"__REQUEST_HEADER__";
M-SEARCH * HTTP/1.1
Host:$IP:$PORT
Man:"ssdp:discover"
ST:ssdp:all
MX:3

__REQUEST_HEADER__

# ST: ssdp:all
# ST: upnp:rootdevice
# ST: urn:schemas-upnp-org:device:MediaServer:1
# ST: urn:schemas-upnp-org:device:MediaRenderer:1
# ST: urn:schemas-upnp-org:device:avm-aha:1



$request_header =~ s/\r//g;
$request_header =~ s/\n/\r\n/g;

$proto = getprotobyname('udp');
socket(S, AF_INET, SOCK_DGRAM, $proto) || die "socket(S): $!\n";
setsockopt(S, SOL_SOCKET, SO_BROADCAST, 1) || die "setsockopt(S): $!\n";
$that = sockaddr_in($PORT, inet_aton($IP));

print $request_header;
send(S, $request_header, 0, $that) || die "send(S): $!\n";

$rin = '';
vec($rin, fileno(S), 1) = 1;
while( select($rout = $rin, undef, undef, $TIMEOUT) ) {
    recv(S, $response_header, 4096, 0) || die "recv(S): $!\n";
    print "Test: $response_header";
}

close(S);
exit 0;
                        

FritzServiceCode.pl

Date : 07/01/2019


#!/usr/bin/perl

use strict;
use warnings;

use LWP::Simple;
use HTML::TokeParser;
use Getopt::Long;


my $url   = "fritz.box";
my $ServiceCode;
my $verbose;
my $help;

my $result = GetOptions ("s=s"     => \$ServiceCode,
                         "servicecode=s"     => \$ServiceCode,
                         "i=s"     => \$url,
                         "ip=s"     => \$url,
                         "verbose" => \$verbose,
                         "v" => \$verbose,
                         "help"    => \$help,
                         "h"    => \$help);

    print "lano's FritzServiceCode - Bitte einmal husten"."\n\n";

if( $help ) {

    print "usage: FritzServiceCode -i \n";
    print "\t-i \t\tFritz!Box Adresse\n";
    print "\t-s \tService Code\n";
    print "\t--help\t\tHilfe\n";
    print "\t--verbose\tVerbose output\n\n";
exit;
} 

if (!$ServiceCode) {
    my $content = get("http://".$url."/cgi-bin/system_status");
    my $p = HTML::TokeParser->new(\$content);
    $p->get_tag("body");
    $ServiceCode = $p->get_trimmed_text;
}




if($ServiceCode =~ /(([^<>]+?)-(\w+)-([01]\d|2[0-3])([0-2]\d|3[01])(0\d|1[01])-([0-2]\d|3[01])([0-5]\d|6[0-3])([0-2]\d|3[01])-([0-7]{6})-([0-7]{6})-(1[49]|21|78|8[35])(67|79)(\d\d)-(\d{2,3})(\d\d)(\d\d)-(\d+)-(\w+)(?:-(\w+))?)/ ){

    my $ServiceCode = $1;
    my $Model = $2;
    my $Annex = $3;
    my $Laufzeit_Stunden = $4;
    my $Laufzeit_Tage = $5;
    my $Laufzeit_Monat = $6;
    my $Laufzeit_Jahre = $7;
    my $Starts = $8 * 32 + $9;
    my $Hash = $10.$11;

    my $deb = "";
    if ($12%64 == 14){
       $deb = "nicht vorhanden.";
      } else {
       $deb = "vorhanden.";
    }

    my $fwa = "";
     if($12 < 64) {
       $fwa = "modifiziert.";
      } else {
       $fwa = "unverändert.";
      }

    my $firmware = "";
    if($13 eq 67) {
        $firmware = "custom";
    }else {
        $firmware = "original"
    }

    my $RunClock = $14;
    my $FirmwareVersion = $15.".".$16.".".$17;
    my $Revision = $18;
    my $Branding = $19;

    my $lang = "keine";
    if ($20) { 
        $lang = $20;
    }

    print "Service Code: \t\t".$ServiceCode."\n";
    print "Model: \t\t\t".$Model."\n";
    print "Annex: \t\t\t".$Annex."\n";
    print "OEM: \t\t\t".$Branding."\n";
    print "Firmware: \t\t".$firmware."\n";
    print "fw_attrib: \t\t".$fwa."\n";
    print "debug.cfg: \t\t".$deb."\n";
    print "Sprache: \t\t".$lang."\n";
    print "Neustarts: \t\t".$Starts."\n";
    print "Laufzeit: \t\t".$Laufzeit_Jahre." Jahre ".$Laufzeit_Monat." Monate ".$Laufzeit_Tage." Tage ".$Laufzeit_Stunden." Stunden \n";
    print "Hash: \t\t\t".$Hash."\n";
    print "FirmwareVersion: \t".$FirmwareVersion."\n";
    print "Projekt: \t\t".$Revision."\n";
    print "RunClock Version: \t".$RunClock."\n";
    print ""."\n";

} else {

    print "Fehler"."\n";

}

                        

FRITZBranding2avm.pl

Date : 07/01/2019


#!/usr/bin/perl

use IO::Socket::INET;
use IO::Select;
use Net::ARP;
use IO::Socket;
use IO::Interface qw(:flags);
use Socket;
use Net::Address::IP::Local;
use Net::IP;
use Net::FTP;
use strict;
use warnings;

sub usage() {
    print STDERR "Usage: $0 \n\n";
    exit 0;
}

my $ip = Net::Address::IP::Local->public_ipv4;;

$ip and $ip =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ or usage();

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

# IP finden
my $address_ipv4 = Net::Address::IP::Local->public_ipv4;

print "local IP: ".$address_ipv4."\n";
( my $network_first_ip = $address_ipv4 ) =~ s/\.\d+\z/.100/;
print "first search IP: ".$network_first_ip."\n";
( my $network_last_ip = $address_ipv4 ) =~ s/\.\d+\z/.254/;
print "last search IP: ".$network_last_ip."\n";

# Interface finden
my $s = IO::Socket::INET->new(Proto => 'udp');
my @interfaces = $s->if_list;

my $interface;
for my $if (@interfaces) {
    if ($s->if_addr($if) eq $address_ipv4) {
        $interface = $s->addr_to_interface($address_ipv4);
        last;
  }
}
print "Network interface: $interface\n";

# freie ip suchen
my $ip2 = new Net::IP ($network_first_ip.' - '.$network_last_ip) || die;
while ($ip2->ip() ne $network_last_ip) {
    print "try IP: ".$ip2->ip(), "\n";
    my  $mac = Net::ARP::arp_lookup($interface,$ip2->ip());
    last if $mac eq "unknown" && $ip2->ip() ne $ip;
    ++$ip2;
}

print "found free IP: ".$ip2->ip()."\n";

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

my $setip =$ip2->ip();
$setip = unpack("N", inet_aton($setip));

my @packets;
foreach my $ver ([18, 1], [22, 2]) {
    push @packets, pack("vCCVNV", 0, @$ver, 1, $setip, 0);
}

my $scanning;

my $probe = IO::Socket::INET->new(Proto => 'udp',
                                  Broadcast => 1,
                                  LocalAddr => $ip,
                                  LocalPort => 5035) or die "socket: $!";

my $sel = IO::Select->new($probe);
my $packet = $packets[0];
my $broadcast = sockaddr_in(5035, INADDR_BROADCAST);

$probe->send($packet, 0, $broadcast);

my @boxes = ();
my $peer;
$scanning = 600;

my $box;

while($scanning) {
  my $reply;
  my @ready;

  if (@ready = $sel->can_read(0.2)) {
    $peer = $probe->recv($reply, 16);
    next if (length($reply) < 16);
    my ($port, $addr) = sockaddr_in($peer);
    my ($major, $minor1, $minor2, $code, $addr2) = unpack("vCCVV", $reply);

    $addr2 = join('.', unpack("C4", pack("N", $addr2)));

    $box = $addr2;

    if ($code == 2) {
      push @boxes, [$major, $minor1, $minor2, $addr, $addr2];
      $scanning = 0 if ($scanning > 2);
    }
  } else {
    $scanning--;
    if (scalar @boxes == 0) {
      $probe->send($packets[0], 0, $broadcast);
    } 
  }
}

if (scalar @boxes == 0) {
  print " none found, giving up.\n";
  exit 1;
}



my $ftp = Net::FTP->new($box, Debug => 1);
$ftp->login("adam2","adam2");

# Branding šndern
$ftp->quot("GETENV", "firmware_version");
$ftp->quot("GETENV", "provider");

$ftp->quot("SETENV", "firmware_version avm");
$ftp->quot("UNSETENV", "provider");

sleep(1);
# Neustart
$ftp->quot("REBOOT");
$ftp->quit;