################################################################ # $Id$ package main; use strict; use warnings; use HttpUtils; use File::Copy qw(mv); use Blocking; sub CommandUpdate($$); sub upd_getUrl($); sub upd_initRestoreDirs($); sub upd_mkDir($$$); sub upd_rmTree($); sub upd_writeFile($$$$); my $updateInBackground; my $updRet; my %updDirs; my $updArg; ######################################## sub update_Initialize($$) { my %hash = ( Fn => "CommandUpdate", Hlp => "[|all|check|force] [http://.../controlfile],update FHEM", ); $cmds{update} = \%hash; } ######################################## sub CommandUpdate($$) { my ($cl,$param) = @_; my @args = split(/ +/,$param); my $arg = (defined($args[0]) ? $args[0] : "all"); my $src = (defined($args[1]) ? $args[1] : "http://fhem.de/fhemupdate/controls_fhem.txt"); my $ret = eval { "Hello" =~ m/$arg/ }; return "first argument must be a valid regexp, all, force or check" if($arg =~ m/^[-\?\*]/ || $ret); $arg = lc($arg) if($arg =~ m/^(check|all|force)$/i); $updateInBackground = AttrVal("global","updateInBackground",undef); $updateInBackground = 0 if($arg ne "all"); $updArg = $arg; if($updateInBackground) { CallFn($cl->{NAME}, "ActivateInformFn", $cl); BlockingCall("doUpdateInBackground", {src=>$src,arg=>$arg}); return "Executing the update the background."; } else { doUpdate($src, $arg); my $ret = $updRet; $updRet = ""; return $ret; } } sub uLog($$) { my ($loglevel, $arg) = @_; return if($loglevel > $attr{global}{verbose} || !defined($arg)); if($updateInBackground) { Log 1, $arg; } else { Log $loglevel, $arg if($updArg ne "check"); $updRet .= "$arg\n"; } } my $inLog = 0; sub update_Log2Event($$) { my ($level, $text) = @_; return if($inLog || $level > $attr{global}{verbose}); $inLog = 1; BlockingInformParent("DoTrigger", ["global", $text, 1], 0); BlockingInformParent("Log", [$level, $text], 0); $inLog = 0; } sub doUpdateInBackground($) { my ($h) = @_; no warnings 'redefine'; # The main process is not affected *Log = \&update_Log2Event; sleep(2); # Give time for ActivateInform / FHEMWEB / JavaScript doUpdate($h->{src}, $h->{arg}); } sub doUpdate($$) { my ($src, $arg) = @_; my ($basePath, $ctrlFileName); if($src !~ m,^(.*)/([^/]*)$,) { uLog 1, "Cannot parse $src, probably not a valid http control file"; return; } $basePath = $1; $ctrlFileName = $2; if(AttrVal("global", "backup_before_update", 0) && $arg ne "check") { my $cmdret = AnalyzeCommand(undef, "backup"); if ($cmdret !~ m/backup done.*/) { uLog 1, "Something went wrong during backup: $cmdret"; uLog 1, "update was canceled. Please check manually!"; return; } uLog 1, "Backup: $cmdret"; } my $remCtrlFile = upd_getUrl($src); return if(!$remCtrlFile); my @remList = split("\n", $remCtrlFile); uLog 4, "Got remote controlfile with ".int(@remList)." entries."; ########################### # read in & digest the local control file my $root = $attr{global}{modpath}; my $restoreDir = ($arg eq "check" ? "" : upd_initRestoreDirs($root)); my @locList; if(($arg eq "check" || $arg eq "all") && open(FD, "$root/FHEM/$ctrlFileName")) { @locList = map { $_ =~ s/[\r\n]//; $_ } ; close(FD); uLog 4, "Got local controlfile with ".int(@locList)." entries."; } my %lh; foreach my $l (@locList) { my @l = split(" ", $l, 4); next if($l[0] ne "UPD"); $lh{$l[3]}{TS} = $l[1]; $lh{$l[3]}{LEN} = $l[2]; } my @excl = split(" ", AttrVal("global", "exclude_from_update", "")); uLog 1, "List of new / modified files since last update:" if($arg eq "check"); ########################### # process the remote controlfile my $nChanged = 0; my $isSingle = ($arg ne "all" && $arg ne "force" && $arg ne "check"); foreach my $r (@remList) { my @r = split(" ", $r, 4); if($r[0] eq "MOV" && ($arg eq "all" || $arg eq "force")) { if($r[1] =~ m+\.\.+ || $r[2] =~ m+\.\.+) { uLog 1, "Suspicious line $r, aborting"; return 1; } upd_mkDir($root, $r[2], 0); uLog 4, "mv $root/$r[1] $root/$r[2]"; } next if($r[0] ne "UPD"); my $fName = $r[3]; if($fName =~ m+\.\.+) { uLog 1, "Suspicious line $r, aborting"; return 1; } my $isExcl; foreach my $ex (@excl) { $isExcl = 1 if($fName =~ m/$ex/); } if($isExcl) { uLog 4, "update: skipping $fName, matches exclude_from_update"; next; } if($isSingle) { next if($fName !~ m/$arg/); } else { next if($lh{$fName} && $lh{$fName}{TS} eq $r[1] && $lh{$fName}{LEN} eq $r[2]); } uLog 1, "$r[0] $fName"; $nChanged++; next if($arg eq "check"); my $remFile = upd_getUrl("$basePath/$fName"); return if(!$remFile); # Error already reported if(length($remFile) ne $r[2]) { uLog 1, "Got ".length($remFile)." bytes for $fName, not $r[2] as expected,"; if($attr{global}{verbose} == 5) { upd_writeFile($root, $restoreDir, "$fName.corrupt", $remFile); uLog 1, "saving it to $fName.corrupt ."; next; } else { uLog 1, "aborting."; return; } } return if(!upd_writeFile($root, $restoreDir, $fName, $remFile)); } if($nChanged == 0) { uLog 1, "nothing to do..."; return; } if($arg eq "check") { my @lines = split(/[\r\n]/,upd_getUrl("$basePath/CHANGED")); my $ret = ""; foreach my $line (@lines) { next if($line =~ m/^#/); last if($line eq ""); $ret .= $line."\n"; } uLog 1, "\nList of last changes:\n".$ret; return; } if($arg eq "all" || $arg eq "force") { # store the controlfile return if(!upd_writeFile($root, $restoreDir, "FHEM/$ctrlFileName", $remCtrlFile)); } uLog(1, ""); uLog 1, 'update finished, "shutdown restart" is needed to activate the changes.'; my $ss = AttrVal("global","sendStatistics",undef); if(!defined($ss)) { uLog(1, ""); uLog(1, "Please consider using the global attribute sendStatistics"); } elsif(defined($ss) && lc($ss) eq "onupdate") { uLog(1, ""); uLog(1, AnalyzeCommandChain(undef, "fheminfo send")); } } sub upd_mkDir($$$) { my ($root, $dir, $isFile) = @_; if($isFile) { # Delete the file Component $dir =~ m,^(.*)/([^/]*)$,; $dir = $1; } return if($updDirs{$dir}); $updDirs{$dir} = 1; my @p = split("/", $dir); for(my $i = 0; $i < int(@p); $i++) { my $path = "$root/".join("/", @p[0..$i]); if(!-d $path) { mkdir $path; uLog 4, "MKDIR $root/".join("/", @p[0..$i]); } } } sub upd_getUrl($) { my ($url) = @_; $url =~ s/%/%25/g; my ($err, $data) = HttpUtils_BlockingGet({ url=>$url }); if($err) { uLog 1, $err; return ""; } if(length($data) == 0) { uLog 1, "$url: empty file received"; return ""; } return $data; } sub upd_writeFile($$$$) { my($root, $restoreDir, $fName, $content) = @_; # copy the old file and save the new upd_mkDir($root, $fName, 1); upd_mkDir($root, "$restoreDir/$fName", 1) if($restoreDir); if($restoreDir && -f "$root/$fName" && ! mv("$root/$fName", "$root/$restoreDir/$fName")) { uLog 1, "mv $root/$fName $root/$restoreDir/$fName failed:$!, ". "aborting the update"; return 0; } my $rest = ($restoreDir ? "trying to restore the previous version and ":""). "aborting the update"; if(!open(FD, ">$root/$fName")) { uLog 1, "open $root/$fName failed: $!, $rest"; mv "$root/$restoreDir/$fName", "$root/$fName" if($restoreDir); return 0; } binmode(FD); print FD $content; close(FD); my $written = -s "$root/$fName"; if($written != length($content)) { uLog 1, "writing $root/$fName failed: $!, $rest"; mv "$root/$restoreDir/$fName", "$root/$fName" if($restoreDir); return; } cfgDB_FileUpdate("$root/$fName") if(configDBUsed()); return 1; } sub upd_rmTree($) { my ($dir) = @_; my $dh; if(!opendir($dh, $dir)) { uLog 1, "opendir $dir: $!"; return; } my @files = grep { $_ ne "." && $_ ne ".." } readdir($dh); closedir($dh); foreach my $f (@files) { if(-d "$dir/$f") { upd_rmTree("$dir/$f"); } else { uLog 4, "rm $dir/$f"; unlink("$dir/$f"); } } uLog 4, "rmdir $dir"; rmdir($dir); } sub upd_initRestoreDirs($) { my ($root) = @_; my $nDirs = AttrVal("global","restoreDirs", 3); if($nDirs !~ m/^\d+$/ || $nDirs < 0) { uLog 1, "invalid restoreDirs value $nDirs, setting it to 3"; $nDirs = 3; } return "" if($nDirs == 0); my $rdName = "restoreDir"; my @t = localtime; my $restoreDir = sprintf("$rdName/%04d-%02d-%02d", $t[5]+1900, $t[4]+1, $t[3]); Log 1, "MKDIR $restoreDir" if(! -d "$root/restoreDir"); upd_mkDir($root, $restoreDir, 0); if(!opendir(DH, "$root/$rdName")) { uLog 1, "opendir $root/$rdName: $!"; return ""; } my @oldDirs = sort grep { $_ !~ m/^\./ && $_ ne $restoreDir } readdir(DH); closedir(DH); while(int(@oldDirs) > $nDirs) { my $dir = "$root/$rdName/". shift(@oldDirs); next if($dir =~ m/$restoreDir/); # Just in case uLog 1, "RMDIR: $dir"; upd_rmTree($dir); } return $restoreDir; } 1; =pod =begin html

update

=end html =begin html_DE

update

=end html_DE =cut