If this is your first visit, be sure to check out the FAQ. You must register before you can post.
IMPORTANT: Your first post will be checked for appropriate content. This may take a bit of time.
root@HomeTrollerZeeS2:/usr/include/arm-linux-gnueabihf/sys# apt-get install libwww-perl Reading package lists... Done Building dependency tree Reading state information... Done The following extra packages will be installed: libencode-locale-perl libfile-listing-perl libfont-afm-perl libhtml-form-perl libhtml-format-perl libhtml-parser-perl libhtml-tagset-perl libhtml-tree-perl libhttp-cookies-perl libhttp-daemon-perl libhttp-date-perl libhttp-message-perl libhttp-negotiate-perl libio-socket-ip-perl libio-socket-ssl-perl liblwp-mediatypes-perl liblwp-protocol-https-perl libmailtools-perl libnet-http-perl libsocket-perl liburi-perl libwww-robotrules-perl Suggested packages: libdata-dump-perl libcrypt-ssleay-perl libauthen-ntlm-perl The following NEW packages will be installed: libencode-locale-perl libfile-listing-perl libfont-afm-perl libhtml-form-perl libhtml-format-perl libhtml-parser-perl libhtml-tagset-perl libhtml-tree-perl libhttp-cookies-perl libhttp-daemon-perl libhttp-date-perl libhttp-message-perl libhttp-negotiate-perl libio-socket-ip-perl libio-socket-ssl-perl liblwp-mediatypes-perl liblwp-protocol-https-perl libmailtools-perl libnet-http-perl libsocket-perl liburi-perl libwww-perl libwww-robotrules-perl 0 upgraded, 23 newly installed, 0 to remove and 150 not upgraded. Need to get 1,198 kB of archives. After this operation, 3,413 kB of additional disk space will be used. Do you want to continue [Y/n]?
assword@IPServer but that doesn't work
#!/usr/bin/perl
# Z-Wave backup utility
# d. g. otto 2016/01/25
# usage: zwbkup.pl [ hs3_host [ formid ... ] ]
use strict;
use warnings;
use English;
use POSIX qw(strftime);
use LWP::UserAgent;
use HTML::TokeParser;
use HTML::Entities;
# the default filename starts with an identifier of the interface type
# guessing for most of these
my %IFMdlPfx = (
0 => "None", # None,
1 => "ZNet", # HomeSeer Z-NET Ethernet
4 => "SmartStick", # HomeSeer SmartStick +
6 => "ZWaveMe", # Z-Wave.me UZB
2 => "ZStick", # Aeon Labs Aeotec Z-Stick
5 => "ZTroller", # HomeSeer Z-Troller
8 => "HomeProZC", # ACT HomePro ZC Series
11 => "ThinkStick", # ControlThink ThinkStick
14 => "AspireUSB", # Cooper Aspire USB
17 => "AspireRFUSB", # Cooper Aspire RF-USB
19 => "SmartStick", # HomeSeer SmartStick Legacy
20 => "CA8700", # Intermatic CA8700
23 => "HA22", # Intermatic HA22
25 => "SigmaUZB", # Sigma Designs UZB
29 => "WDUSB10", # Wayne-Dalton WDUSB-10
32 => "Serial", # Generic Serial Controller
35 => "ZNet", # Ethernet Interface
);
# current timestamp portion of backup file name
my $now = strftime("%Y-%m-%d_%H.%M.%S", localtime);
# cmdline parameter 1: HS3 host
my $host = shift;
$host ||= 'localhost';
my $url = "http://$host/ZWaveControllers";
my $user = 'admin';
my $pass = 'password';
my $ua = LWP::UserAgent->new();
$ua->agent("USER/AGENT/IDENTIFICATION");
# cmdline parameter 2+: form id(s) to process
my @formids = @ARGV;
@formids = get($url) unless @formids;
print "Form ID(s): ", join(",", @formids), "\n";
foreach my $formid (@formids) {
# 1st time selects action "Back Up this interface"
get($url, $formid);
# 2nd time sets the filename and submits the START button to perform the backup
get($url, $formid);
sleep 2;
# this seems to keep it happy...
post($url, [ action => 'updatetime' ]);
sleep 1;
}
my (%friendly, %homeid);
sub get {
my ($url, $formid) = @ARG;
print "GET $url\n";
my $request = HTTP::Request->new(GET => $url);
$request->authorization_basic($user, $pass);
my $rsp = $ua->request($request);
print $rsp->status_line, "\n";
exit unless $rsp->is_success;
my $content = $rsp->as_string;
my $p = HTML::TokeParser->new(\$content);
my ($form, $select, $optval, $submit, $text, @postdata, %p);
my ($friendly, $homeid, $tcol);
my @formids;
while (my $tok = $p->get_token) {
my @tok = @$tok;
my $op = shift @tok;
if ($op eq 'S') { # tag Start
my ($tag, $attr, $attrseq, $origtext) = @tok;
my %attr = %$attr;
if ($tag eq 'form') {
# form name
$form = $attr{name};
} elsif ($tag eq 'input') {
if ($attr{type} eq 'text' and $attr{name}) {
if ($attr{name} =~ /^Friendly_([0-9A-F]+)/) {
# parse the Networks and Options form for
# Network Friendly Name and Home ID
$homeid = $1;
$friendly = $attr{value};
$tcol = 1; # table column number
} elsif ($attr{name} =~ /^NewName_[0-9A-F]+/) {
# Interface Name
# available for use when building the backup file name
$p{IFName} = $attr{value};
} elsif ($attr{name} =~ /^File_[0-9A-F]+/) {
# set the backup file name as appropriate
my $filename = $attr{value};
$filename = generate_filename($filename, %p);
push(@postdata, $attr{name} => $filename);
}
}
} elsif ($tag eq 'select') {
# name of select pulldown form field
$select = $attr{name};
} elsif ($tag eq 'option') {
# an option within a select form field
$optval = $attr{value};
if ($attr{selected} and $select =~ /IFModel_/) {
# index of selected Interface Model
# available for use when building the backup file name
$p{IFModelIndex} = $attr{value} || 0;
}
} elsif ($tag eq 'button') {
# submit button
if ($attr{name} =~ /^GO_[0-9A-F]+/) {
# submit the form
push(@postdata, %attr);
}
}
} elsif ($op eq 'E') { # tag End
my $tag = shift @tok;
if ($tag eq 'form') {
# end of form - post queued changes
if ($form and $form =~ /^Form_([0-9A-F]+)/ and @postdata) {
my $thisid = $1;
push(@formids, $thisid);
if ($formid and $formid eq $thisid) {
post($url, \@postdata);
}
}
undef $form;
undef @postdata;
undef %p;
} elsif ($tag eq 'select') {
undef $select;
} elsif ($tag eq 'option') {
# end of option - text label is available for query
if ($select =~ /^OpSelect_/ and $text =~ /back\s*up/i) {
# set action to 'Back Up this interface';
push(@postdata, $select => $optval);
}
undef $optval;
} elsif ($tag eq 'td') {
# table data
if ($tcol and $tcol++ == 4) {
# Interface Name is in 4th column of table displaying
# Z-Wave Networks and Options
my $ifname = $text;
# Network Friendly Name and Home ID
# available for use when building the backup file name
$friendly{$ifname} = $friendly;
$homeid{$ifname} = $homeid;
undef $tcol;
}
}
} elsif ($op eq 'T') { # Text
($text) = @tok;
$text =~ s/[\r\n]//g;
$text =~ s/^\s+|\s+$//g;
$text = decode_entities($text);
}
}
return @formids;
}
my %submit;
# POST the changes
sub post {
my ($url, $postdata) = @ARG;
my @p = @$postdata;
# don't submit same button more than once
my %p = @p;
if ($p{name}) {
return if $submit{$p{name}};
$submit{$p{name}}++;
}
print "POST $url\n[\n";
for (my $ii = 0; $ii < @p; $ii += 2) {
print " $p[$ii] => $p[$ii+1]\n";
}
print "]\n";
my $rsp = $ua->post($url, $postdata);
print $rsp->status_line, "\n";
exit unless $rsp->is_success;
}
# routine to generate the backup file name
# default behaviour is
# {IFModel}_{FriendlyName}_{HomeID}_{TimeStamp}.ZWave
# customize as desired
sub generate_filename {
my ($givenname, %p) = @ARG;
# interface name
my $ifname = $p{IFName};
# Network Friendly Name
my $friendly = $friendly{$ifname};
# HomeID
my $homeid = $homeid{$ifname};
# map interface model index to abbreviation defined above
my $idx = $p{IFModelIndex};
my $mdlpfx = $IFMdlPfx{$idx};
# build the darn thing!
my $newname = "${mdlpfx}_${friendly}_${homeid}_${now}.ZWave";
return $newname;
}
Comment