From feb98118de4117774865587c403b692e2e8c5ddb Mon Sep 17 00:00:00 2001 From: rudolfkoenig <> Date: Sun, 22 Mar 2015 12:27:02 +0000 Subject: [PATCH] contrib/statistics: missing stuff added git-svn-id: https://svn.fhem.de/fhem/trunk@8261 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/contrib/statistics/admin.cgi | 584 +++++++++++++++++++++++ fhem/contrib/statistics/data/mkpasswd.pl | 7 + 2 files changed, 591 insertions(+) create mode 100755 fhem/contrib/statistics/admin.cgi create mode 100755 fhem/contrib/statistics/data/mkpasswd.pl diff --git a/fhem/contrib/statistics/admin.cgi b/fhem/contrib/statistics/admin.cgi new file mode 100755 index 000000000..2ef2ed08a --- /dev/null +++ b/fhem/contrib/statistics/admin.cgi @@ -0,0 +1,584 @@ +#!/usr/bin/perl -w +################################################################ +# $Id:$ +# vim: ts=2:et +# +# (c) 2012 Copyright: Martin Fischer (m_fischer at gmx dot de) +# All rights reserved +# +# This script free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# any later version. +# +# The GNU General Public License can be found at +# http://www.gnu.org/copyleft/gpl.html. +# A copy is found in the textfile GPL.txt and important notices to the license +# from the author is found in LICENSE.txt distributed with these scripts. +# +# This script is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +################################################################ +use CGI qw(:standard :html3 :header Vars); +use CGI::Carp qw(warningsToBrowser fatalsToBrowser carpout); +use CGI::Session; +use DBI; #requires libdbd-sqlite3-perl +use File::Copy; +use LWP::Simple; +use IO::Uncompress::Gunzip qw(gunzip $GunzipError); +use lib "./lib"; +use Geo::IP; +use strict; +use warnings; +no warnings 'uninitialized'; + +# directory cointains databases +my $datadir = "./data"; + +# geo ip database file from http://www.maxmind.com/download/geoip/database/ +# should be updated once per month +my $geoIPDat = "$datadir/GeoLiteCity.dat"; + +# database +my $dbf = "$datadir/fhem_statistics_db.sqlite"; +my $dsn = "dbi:SQLite:dbname=$dbf"; +my $sth; + +# requirements for housekeeping; +my $controlFileURL = "http://fhem.de/fhemupdate4/svn/controls_fhem.txt"; + +# fhem node +my $ua = $ENV{HTTP_USER_AGENT}; +my $ip = $ENV{REMOTE_ADDR}; + +# cascading style sheets +my $css = "http://fhem.de/../css/style.css"; +my $myStyle=<connect($dsn,"","", { RaiseError => 1, ShowErrorStatement => 1 }) || + die "Cannot connect: $DBI::errstr"; + +my $cgi = new CGI; +my $session = new CGI::Session(undef, $cgi, {Directory=>'/tmp'}); + +my $cookie = $cgi->cookie(CGISESSID => $session->id ); + +&init($cgi,$session); + +if($session->param("~login-trials") >= 3) { + print $cgi->header(), + $cgi->start_html( + -title => 'fhem.de - Statistics Maintainance mode', + -author => 'm_fischer@gmx.de', + -base => 'true', + -style => {-src => $css,-code => $myStyle}, + ), + $cgi->p("You failed 3 times in a row.
" . + "Your session is blocked. Please contact us with the details of your action" + ), + $cgi->end_html; + exit(0); +} + +unless($session->param("~logged-in")) { + print login_page($cgi,$session); + exit(0); +} + +&maintainance($cgi,$session); + +exit(0); + +######################################## +sub login_page { + my ($cgi,$session) = @_; + print $cgi->header(-cookie=>$cookie), + $cgi->start_html( + -title => 'fhem.de - Statistics Maintainance mode', + -author => 'm_fischer@gmx.de', + -base => 'true', + -style => {-src => $css,-code => $myStyle}, + ), + $cgi->h3("fhem.de - Statistics Maintainance mode"), + $cgi->start_form, + $cgi->hidden(-name=>'_cmd',-value=>$cgi->param('_cmd')), + $cgi->hidden(-name=>'_act',-value=>$cgi->param('_act')), + $cgi->strong("Username: "), + $cgi->textfield(-name=>'username'),br, + $cgi->strong("Password: "), + $cgi->password_field(-name=>'password'),br, + $cgi->submit(-value=>'Login'), + $cgi->end_form, + $cgi->end_html; +} + +######################################## +sub init($$) { + my ($cgi,$session) = @_; + + if($session->param("~logged-in")) { + return 1; + } + + my $username = $cgi->param("username") or return; + my $password = $cgi->param("password") or return; + + if(my $profile = authUser($username,$password)) { + $session->param("~profile", $profile); + $session->param("~logged-in", 1); + $session->clear(["~login-trials"]); + return 1; + } + + my $trials = $session->param("~login-trials") || 0; + return $session->param("~login-trials", ++$trials); +} + +######################################## +sub authUser($$) { + my ($username,$password) = @_; + + my %credentials; + my $fh; + if(open($fh,"<$datadir/.maintainance.pwd")) { + while (my $line = <$fh>) { + chomp $line; + my ($user,$pass) = split(":",$line); + $credentials{$user} = $pass; + } + close $fh; + } + + if(exists $credentials{$username} && + crypt($password,"Fhem") eq $credentials{$username}) { + my $p_mask = "x" . length($credentials{$username}); + return {username=>$username, password=>$p_mask}; + } + return undef; +} + +######################################## +sub maintainance($$) { + my ($cgi,$session) = @_; + my $url = url(-path_info=>1); + my $profile = $session->param("~profile"); + my @geo = getLocation($ip); + + if($cgi->param("_file")) { + &cmdDownload($cgi,$session,param("_file")); + } + + print $cgi->header(), + $cgi->start_html( + -title => 'fhem.de - Statistics Maintainance mode', + -author => 'm_fischer@gmx.de', + -base => 'true', + -style => {-src => $css,-code => $myStyle}, + ), + $cgi->h3("fhem.de - Statistics Maintainance mode"); + + print $cgi->p("Welcome $profile->{username} ..."), + $cgi->p("IP: $ip, countryname:$geo[2] city:$geo[5] lat:$geo[6] lon:$geo[7]"), + $cgi->ul({-class=>'menu'}, + $cgi->li([ + "[", + $cgi->a({href=>$url},"home"), + "|", + $cgi->a({href=>$url."?_cmd=backup"},"backup"), + "|", + $cgi->a({href=>$url."?_cmd=dir"},"dir"), + "|", + $cgi->a({href=>$url."?_cmd=housekeeping"},"housekeeping"), + "|", + $cgi->a({href=>$url."?_cmd=update"},"update"), + "|", + $cgi->a({href=>$url."?_cmd=help"},"help"), + "|", + $cgi->a({href=>"http://fhem.de/stats/statistics.cgi",-target=>'_blank'},"view statistics"), + "|", + $cgi->a({href=>$url."?_cmd=logout"},"logout"), + "]", + ]) + ), + $cgi->hr; + + my $cmd = $cgi->param("_cmd"); + my $act = $cgi->param("_act"); + + if($cmd) { + + my $error; + my @t = localtime; + my $timeNow = sprintf("%04d%02d%02d-%02d%02d%02d",$t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]); + my $ret; + + if($cmd eq "help") { + &cmdHelp($cgi,$session); + } elsif($cmd eq "backup") { + &cmdBackup($cgi,$session,$act); + } elsif($cmd eq "dir") { + &cmdDir($cgi,$session); + } elsif($cmd eq "housekeeping") { + &cmdHousekeeping($cgi,$session,$act); + } elsif($cmd eq "update") { + &cmdUpdate($cgi,$session,$act); + } elsif($cmd eq "logout") { + $session->clear(["~logged-in"]); + print "\n"; + } + + if($error) { + print $cgi->p("Error: $error"); + } + + } + + print end_html; + +} + +######################################## +sub cmdHelp($$) { + my ($cgi,$session) = @_; + + print $cgi->h4("Help"), + $cgi->table({-border=>0,-cellpadding=>'5'}, + $cgi->Tr({-align=>'left',-valign=>'top'}, + [ + $cgi->th([ + "command", + "action", + "short description" + ]), + $cgi->td([ + "help", + "", + "show this info." + ]), + $cgi->td([ + "backup", + "statistics", + "backup statisitc database with timestamp extension" + ]), + $cgi->td([ + "backup", + "geoip", + "backup geoip databae with timestamp extension" + ]), + $cgi->td([ + "dir", + "", + "show content of datadir '$datadir'" + ]), + $cgi->td([ + "housekeeping", + "modules", + "get controlfile from '$controlFileURL' and remove inofficial modules from table 'modules'" + ]), + $cgi->td([ + "update", + "geoip", + "get new version of geoip database 'GeoLiteCity.dat', unzip and install it." + ]), + ] + ) + ); + return undef; +} + +######################################## +sub cmdBackup($$$) { + my ($cgi,$session,$act) = @_; + my $url = url(-path_info=>1); + my $timeNow = TimeNow(); + my $error; + + print $cgi->h4("Backup"), + $cgi->ul({-class=>'menu'}, + $cgi->li([ + "[", + $cgi->a({href=>$url."?_cmd=backup;_act=statistics"},"statistics database "), + "|", + $cgi->a({href=>$url."?_cmd=backup;_act=geoip"},"geoip database "), + "|", + $cgi->a({href=>$url."?_cmd=backup;_act=download;_file=$dbf"},"download statistics database "), + "]", + ]) + ); + + if($act eq "statistics") { + print $cgi->h5("backup $dbf"); + copy($dbf,$dbf."-".$timeNow) or $error = "Copy failed: $!"; + print $cgi->p("copy $dbf to $dbf-$timeNow done."); + } + + if($act eq "geoip") { + print $cgi->h5("backup $geoIPDat"); + copy($geoIPDat,$geoIPDat."-".$timeNow) or $error = "Copy failed: $!"; + print $cgi->p("copy $geoIPDat to $geoIPDat-$timeNow done."); + } + + if($error) { + print $cgi->p("Error: $error"); + } + + return undef; +} + +######################################## +sub cmdDownload($$$) { + my ($cgi,$session,$file) = @_; + my $error; + + my $filename = substr $file,rindex($file,'/')+1; + open(my $DLFILE,"<$file") or $error = "Open failed: $!"; + + print $cgi->header(-type => 'application/x-download', + -attachment => $filename, + -Content_length => -s "$file", + ); + + binmode $DLFILE; + print while <$DLFILE>; + undef ($DLFILE); + + if($error) { + print $cgi->p("Error: $error"); + } + +} + +######################################## +sub cmdDir($$$) { + my ($cgi,$session,$act) = @_; + my $error; + + print $cgi->h4("Content of directory $datadir"); + + opendir(my $dh, $datadir) or $error = "Can't opendir $datadir: $!"; + my @dir = grep { !/^\./ && -f "$datadir/$_" } readdir($dh); + closedir $dh; + + for my $file (sort @dir) { + print $cgi->code($file),$cgi->br; + } + + if($error) { + print $cgi->p("Error: $error"); + } + + return undef; +} + +######################################## +sub cmdUpdate($$$) { + my ($cgi,$session,$act) = @_; + my $url = url(-path_info=>1); + my $timeNow = TimeNow(); + my $error; + + print $cgi->h4("Update"), + $cgi->ul({-class=>'menu'}, + $cgi->li([ + "[", + $cgi->a({href=>$url."?_cmd=update;_act=geoip"},"GeoLiteCity.dat"), + "]", + ]) + ); + + if($act eq "geoip") { + print $cgi->h5("update GeoLiteCity.dat"); + + my $url = "http://geolite.maxmind.com/download/geoip/database/GeoLiteCity.dat.gz"; + my $infile = "$datadir/GeoLiteCity.dat.gz"; + my $outfile = "$datadir/GeoLiteCity.dat"; + my $data = getstore($url,$infile); + + if($data == "200") { + copy($geoIPDat,$geoIPDat."-".$timeNow) or $error = "Copy failed: $!"; + print $cgi->p("copy $geoIPDat to $geoIPDat-$timeNow done."); + gunzip $infile => $outfile or $error = "gunzip failed: $GunzipError"; + print $cgi->p("New $outfile installed."); + } else { + $error = "response for $infile: $data"; + } + } + + if($error) { + print $cgi->p("Error: $error"); + } + + return undef; +} + +######################################## +sub cmdHousekeeping($$$) { + my ($cgi,$session,$act) = @_; + my $url = url(-path_info=>1); + my $error; + + print $cgi->h4("Housekeeping"), + $cgi->ul({-class=>'menu'}, + $cgi->li([ + "[", + $cgi->a({href=>$url."?_cmd=housekeeping;_act=modules"},"remove inofficial modules"), + "]", + ]) + ); + + if($act eq "modules") { + + my $control = get($controlFileURL); + my $control_ref = {}; + ($error,$control_ref) = parseControlFile("fhem",$control,$control_ref,0); + + print $cgi->h5("Housekeeping for table 'modules'"); + my @ignoreColumns = qw(Global uniqueID); + + my %columnOld = %{ $dbh->column_info(undef, undef, 'modules', undef)->fetchall_hashref('COLUMN_NAME') }; + my %columnNew = %columnOld; + + my $removeColumns; + foreach my $col (sort keys %columnOld) { + if(!exists $control_ref->{$col} && !grep {/$col/} @ignoreColumns) { + delete $columnNew{$col}; + $removeColumns .= "$col "; + } + } + + if(!$removeColumns) { + print $cgi->p("

inofficial modules found:
none"); + } else { + print $cgi->p("

inofficial modules found:
$removeColumns"); + + copy($dbf,$dbf."-".TimeNow()) or $error = "Copy of $dbf failed: $!"; + + if(!$error) { + delete $columnNew{uniqueID}; + my $createTable = "CREATE TABLE modules (uniqueID VARCHAR(32) PRIMARY KEY UNIQUE"; + my $selectColumns = "uniqueID"; + foreach my $col (sort keys %columnNew) { + $createTable .= ", $col INTEGER DEFAULT 0"; + $selectColumns .= ", $col"; + } + $createTable .= ");"; + + my $sql; + $sql = "ALTER TABLE 'modules' RENAME TO 'modules_old';"; + print $cgi->p("sql:
$sql"); + $dbh->do($sql); + + $sql = $createTable; + print $cgi->p("sql:
$sql"); + $dbh->do($sql); + + $sql = "INSERT INTO 'modules' ($selectColumns) SELECT $selectColumns FROM 'modules_old';"; + print $cgi->p("sql:
$sql"); + $dbh->do($sql); + + $sql = "DROP TABLE 'modules_old';"; + print $cgi->p("sql:
$sql"); + $dbh->do($sql); + } + } + } + + if($error) { + print $cgi->p("Error: $error"); + } + + return undef; +} + +######################################## +sub parseControlFile($$$$) { + my ($pack,$controlFile,$control_ref,$local) = @_; + my %control = %$control_ref if ($control_ref && ref($control_ref) eq "HASH"); + my $from = ($local ? "local" : "remote"); + my $ret; + + if ($local) { + my $str = ""; + # read local controlfile in string + if (open FH, "$controlFile") { + $str = do { local $/; }; + } + close(FH); + $controlFile = $str + } + # parse file + if ($controlFile) { + foreach my $l (split("[\r\n]", $controlFile)) { + chomp($l); + my ($ctrl,$date,$size,$file,$move) = ""; + if ($l =~ m/^(UPD) (20\d\d-\d\d-\d\d_\d\d:\d\d:\d\d) (\d+) (\S+)$/) { + $ctrl = $1; + $date = $2; + $size = $3; + $file = $4; + } elsif ($l =~ m/^(DIR) (\S+)$/) { + $ctrl = $1; + $file = $2; + } elsif ($l =~ m/^(MOV) (\S+) (\S+)$/) { + $ctrl = $1; + $file = $2; + $move = $3; + } elsif ($l =~ m/^(DEL) (\S+)$/) { + $ctrl = $1; + $file = $2; + } else { + $ctrl = "ESC" + } + if ($ctrl eq "ESC") { + $ret = "File 'controls_".lc($pack).".txt' ($from) is corrupt"; + } + last if ($ret); + if ($l =~ m/^UPD/ && $file =~ m/^FHEM/) { + if ($file =~ m/^.*(\d\d_)(.*).pm$/) { + my $modName = $2; + $control{$modName} = $file; + } + } + } + } + return ($ret, \%control); +} + +######################################## +sub getLocation($) { + my ($ip) = shift; + my $gi = Geo::IP->open($geoIPDat, GEOIP_STANDARD); + my $rec = $gi->record_by_addr($ip); + + if(!$rec) { + return; + } else { + return ( + $rec->country_code,$rec->country_code3,$rec->country_name,$rec->region,$rec->region_name,$rec->city, + $rec->latitude,$rec->longitude,$rec->time_zone,$rec->continent_code + ); + } +} + +######################################## +sub TimeNow() { + my @t = localtime; + return sprintf("%04d%02d%02d-%02d%02d%02d",$t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]); +} + +1; diff --git a/fhem/contrib/statistics/data/mkpasswd.pl b/fhem/contrib/statistics/data/mkpasswd.pl new file mode 100755 index 000000000..754e39f0f --- /dev/null +++ b/fhem/contrib/statistics/data/mkpasswd.pl @@ -0,0 +1,7 @@ +#!/usr/bin/perl +use strict; + +my $user = $ARGV[0]; +my $pass = $ARGV[1]; +print "$user:".crypt($pass,"Fhem")."\n"; +exit 0;