01_FHEMWEB.pm: add logDevice attribute (Forum #113192)

git-svn-id: https://svn.fhem.de/fhem/trunk@22520 2b470e98-0d58-463d-a4d8-8e2adae1ed80

fhem/FHEM/01_FHEMWEB.pm

@@ -181,6 +181,8 @@ FHEMWEB_Initialize($)
     iconPath
     longpoll:0,1,websocket
     longpollSVG:1,0
+    logDevice
+    logFormat
     menuEntries
     mainInputLength
     nameDisplay
@@ -622,6 +624,7 @@ FW_finishRead($$$)
   my $expires = ($cacheable ?
          "Expires: ".FmtDateTimeRFC1123($hash->{LASTACCESS}+900)."\r\n" : 
          "Cache-Control: no-cache, no-store, must-revalidate\r\n");
+  FW_log($arg, $length) if(AttrVal($FW_wname, "logDevice", undef));
   Log3 $FW_wname, 4,
         "$FW_wname: $arg / RL:$length / $FW_RETTYPE / $compressed / $expires";
   if( ! FW_addToWritebuffer($hash,
@@ -3495,6 +3498,36 @@ FW_show($$)
   return undef;
 }
 
+sub
+FW_log($$)
+{
+  my ($arg, $length) = @_;
+
+  my $c = $defs{$FW_cname};
+  my $fmt = AttrVal($FW_wname, "logFormat", '%h %l %u %t "%r" %>s %b');
+  my $rc = $FW_httpRetCode;
+  $rc =~ s/ .*//;
+  $arg = substr($arg,0,5000)."..." if(length($arg) > 5000);
+
+  my @t = localtime;
+  my %cp = (
+    h=>$c->{PEER},
+    l=>"-",
+    u=>$c->{AuthenticatedUser} ? $c->{AuthenticatedUser} : "-",
+    t=>strftime("%d/%b/%Y:%H:%M:%S %z",@t),
+    r=>$arg,
+    ">s"=>$rc,
+    b=>$length
+  );
+
+  $fmt =~ s/%([^" ]*)/defined($cp{$1}) ? $cp{$1} : "%$1"/ge;
+  $fmt =~ s/%{([^" ]*)}/defined($FW_httpheader{$1}) ?$FW_httpheader{$1}:"$1"/ge;
+
+  my $ld = AttrVal($FW_wname, "logDevice", undef);
+  CallFn($ld, "LogFn", $defs{$ld}, $fmt) if($defs{$ld});
+}
+
+
 1;
 
 =pod
@@ -3911,6 +3944,20 @@ FW_show($$)
        </code></ul>
        </li><br>
 
+    <a name="logDevice"></a>
+    <li>logDevice fileLogName<br>
+       Name of the FileLog instance, which is used to log each FHEMWEB access.
+       To avoid writing wrong lines to this file, the regexp should be set to
+       <WebName>:Log
+       </li><br>
+
+    <a name="logFormat"></a>
+    <li>logFormat ...<br>
+        Default is the Apache common Format (%h %l %u %t "%r" %>s %b).
+        Currently only these "short" place holders are replaced. Additionally,
+        each HTTP Header X can be accessed via %{X}.
+       </li><br>
+
     <a name="longpoll"></a>
     <li>longpoll [0|1|websocket]<br>
         If activated, the browser is notifed when device states, readings or
@@ -4655,6 +4702,21 @@ FW_show($$)
        </code></ul>
        </li><br>
 
+    <a name="logDevice"></a>
+    <li>logDevice fileLogName<br>
+       Name einer FileLog Instanz, um Zugriffe zu protokollieren.
+       Um das Protokollieren falscher Eintr&auml;ge zu vermeiden, sollte das
+       FileLog Regexp der Form <WebName>:Log sein.
+       </li><br>
+
+    <a name="logFormat"></a>
+    <li>logFormat ...<br>
+        Voreinstellung ist das Apache common Format (%h %l %u %t "%r" %>s %b).
+        Z.Zt. werden nur diese "kurzen" Platzhalter ersetzt, weiterhin kann man
+        mit %{X} den HTTP-Header-Eintrag X spezifizieren.
+       </li><br>
+
+
     <a name="longpoll"></a>
     <li>longpoll [0|1|websocket]<br>
         Falls gesetzt, FHEMWEB benachrichtigt den Browser, wenn

fhem/FHEM/92_FileLog.pm

@@ -38,6 +38,7 @@ FileLog_Initialize($)
   #$hash->{DeleteFn} = "FileLog_Delete";
   $hash->{NotifyFn} = "FileLog_Log";
   $hash->{AttrFn}   = "FileLog_Attr";
+  $hash->{LogFn}    = "FileLog_DirectLog";
   # logtype is used by the frontend
   no warnings 'qw';
   my @attrList = qw(
@@ -252,6 +253,25 @@ FileLog_Switch($)
   return 0;
 }
 
+sub
+FileLog_LogTailWork($$$$)
+{
+  my ($log, $ln, $tn, $written) = @_;
+  my $fh = $log->{FH};
+  if($fh) {
+    $fh->flush;
+    # Skip sync, it costs too much HD strain, esp. on SSD
+    # $fh->sync if !($^O eq 'MSWin32'); #not implemented in Windows
+  }
+  my $owr = ReadingsVal($ln, "linesInTheFile", 0);
+  my $eot = AttrVal($ln, "eventOnThreshold", 0);
+  if($eot && ($owr+$written) % $eot == 0) {
+    readingsSingleUpdate($log, "linesInTheFile", $owr+$written, 1);
+  } else {
+    setReadingsVal($log, "linesInTheFile", $owr+$written, $tn);
+  }
+}
+
 #####################################
 sub
 FileLog_Log($$)
@@ -322,23 +342,21 @@ FileLog_Log($$)
     }
   }
   return "" if(!$written);
-
+  FileLog_LogTailWork($log, $ln, $tn, $written);
-  if($fh) {
-    $fh->flush;
-    # Skip sync, it costs too much HD strain, esp. on SSD
-    # $fh->sync if !($^O eq 'MSWin32'); #not implemented in Windows
-  }
-  my $owr = ReadingsVal($ln, "linesInTheFile", 0);
-  my $eot = AttrVal($ln, "eventOnThreshold", 0);
-  if($eot && ($owr+$written) % $eot == 0) {
-    readingsSingleUpdate($log, "linesInTheFile", $owr+$written, 1);
-  } else {
-    setReadingsVal($log, "linesInTheFile", $owr+$written, $tn);
-  }
-
   return "";
 }
 
+#####################################
+sub
+FileLog_DirectLog($$)
+{
+  my ($log, $txt) = @_;
+  FileLog_Switch($log);
+  my $fh = $log->{FH};
+  print $fh $txt,"\n";
+  FileLog_LogTailWork($log, $log->{NAME}, TimeNow(), 1);
+}
+
 ###################################
 sub
 FileLog_Attr(@)