From 241a2de2cead733160d4df7045731f9e746fddfd Mon Sep 17 00:00:00 2001 From: wbudic Date: Wed, 18 Aug 2021 17:58:27 +1000 Subject: [PATCH] Imp. META reserv anon handling. --- dbLifeLog/main.cnf | 12 +- htdocs/cgi-bin/config.cgi | 144 +++++++++++++++++----- htdocs/cgi-bin/login_ctr.cgi | 28 +++-- htdocs/cgi-bin/system/modules/Settings.pm | 89 +++++++++++-- 4 files changed, 216 insertions(+), 57 deletions(-) diff --git a/dbLifeLog/main.cnf b/dbLifeLog/main.cnf index 2bc8782..07f0a3e 100644 --- a/dbLifeLog/main.cnf +++ b/dbLifeLog/main.cnf @@ -8,8 +8,8 @@ This is an Open Source License project -> https://choosealicense.com/licenses/is <>> # BACKUP_ENABLED -> Enable (1), disable (0) backups to be restored from config page. <>> -<>> -<>> +<>> +<>> # Default database driver prefix, is SQLite. Note Remove -> '!' prefix to tag name, to enable, set, @@ -54,8 +54,10 @@ BankingPlugin->banking.pl <>> <=6 AND >>> +#For internal use only. +<<^CONFIG_META<200>The reserved id range for config table is from 200, upwards.>> # -# The following are initial setup constance's. +# The following are initial setup constance's. We use them instead of hard coding a lot. # Modifying them after the fact of a database creation is futile, a limp biscuit. # Use/see anon properties before, enabling changing settings from this actual config file. # @@ -67,10 +69,11 @@ BankingPlugin->banking.pl 08|$LOG_PATH = ../../dbLifeLog/`Path to folder containing data. 10|$SESSN_EXPR = +30m`Login session expiration time setting, can be seconds, minutes or hours. 12|$DATE_UNI = 0`Setting of how dates are displayed, universal yyyy-mm-dd or local dd-mm-yyyy. -14|$LANGUAGE = English`Default language locale. +14|$LANGUAGE = English`Default language locale. 18|$IMG_W_H = 210x120`Default embedded image width. 20|$AUTO_WRD_LMT= 1024`Autocomplete word gathering limit. 22|$AUTO_LOGIN = 0`Autologin option, that expires only if login out. Enter Credentials in main.cnf. +23|$AUTO_LOGOFF = 0`Auto logoff on session expires, default is false. 24|$FRAME_SIZE = 0`Youtube frame size settings, 0 - Large, 1 - Medium, 2- Small. 26|$RTF_SIZE = 2`RTF Document height, 0 - Large, 1 - Medium, 2- Small. 28|$THEME = Standard`Theme to apply, Standard, Sun, Moon, Earth. @@ -81,6 +84,7 @@ BankingPlugin->banking.pl 38|$COMPRESS_ENC=0`Compress Encode pages, default -> 0=false, 1=true. 40|$SUBPAGEDIR =docs`Directory to scan for subpages like documents. 42|$DISP_ALL = 1`Display whole log entry, default -> 1=true, 0=false for display single line only. +44|$TRANSPARENCY= 1`Should log panel be transparent, default is yes or on. >> < 01|Unspecified `For quick uncategorized entries. diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index e7610c6..430f03d 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -336,9 +336,9 @@ my $frmDB = qq( Perform this change/check in the event of experiencing data problems. Or periodically for data check and maintenance.
- Use 'Reset Settings' option to revert to current stored configuration. Changes you made.
+ Use 'Reset Settings' option to revert to current stored configuration. The changes you made since installation.
Use the 'Wipe Settings' option if updating the application or need new defaults from main.cnf config file.
- Select both to reset and wipe, to overwrite all changes you made to config file settings. + Select both to reset and wipe, to overwrite all changes you made to config file settings.
WARNING! Checking any of the above extra actions will cause loss of your changes. Please, export/backup first. @@ -368,7 +368,7 @@ next if $file eq '.' or $file eq '..' or index ($file , 'bck_') == -1; push @backups, $file; } close $dir; -foreach $file (sort @backups){ +foreach my $file (sort @backups){ #my $n = substr $file, length(&Settings::logPath); $bck_list .= "$file
"; } @@ -790,9 +790,9 @@ try{ getHeader() if(&Settings::debug); print "

Database Records Fix Result

\n
" if &Settings::debug; print "
Started transaction!\n" if &Settings::debug;
-        #Transaction work if driver is set properly!
-        my $p = Settings::pass(); 
-        $db = DBI->connect(Settings::dsn(), $alias, $p, {AutoCommit => 0, RaiseError => 1, PrintError => 0, show_trace=>1});
+        #Transactions work if driver is set properly!
+        $db   = Settings::connectDBWithAutocommit(1);
+        #DBI->connect(Settings::dsn(), $alias, $p, {AutoCommit => 0, RaiseError => 1, PrintError => 0, show_trace=>1});
         $db->do('BEGIN TRANSACTION;');
         # Check for duplicates, which are possible during imports or migration as internal rowid is not primary in log.
         # @TODO This should be selecting an cross SQL compatibe view.
@@ -824,12 +824,30 @@ try{
         
         &renumerate;        
         print "Doing removeOldSessions next..." if &Settings::debug;
-        &Settings::removeOldSessions;
+            &Settings::removeOldSessions;
         print "done!\n" if &Settings::debug;
-        
-        &resetCategories if $rs_cats;
-        &resetSystemConfiguration($db) if $rs_syst;
-        &wipeSystemConfiguration if $wipe_ss;
+        if ($rs_cats){
+            print "Doing resetSystemConfiguration next..." if &Settings::debug;
+                #Let migration algorithm handle re-creation on logon.
+                $db->do("DELETE FROM CAT;");
+                $db->do("DROP TABLE CAT;");
+                $LOGOUT = 1;
+            print "done!\n" if &Settings::debug;
+        }
+        if ($rs_syst) {
+            print "Doing resetSystemConfiguration next..." if &Settings::debug;
+                &resetSystemConfiguration($db);
+            print "Doing resetSystemConfiguration next..." if &Settings::debug;
+        }
+        if ($wipe_ss) {
+            print "Doing wipeSystemConfiguration next..." if &Settings::debug;
+            Settings::saveReserveAnons(); #So we can bring back from dead application reserve variables.
+                #Let migration algorithm handle re-creation on logon.
+                $db->do("DELETE FROM CONFIG;");
+                $db->do("DROP TABLE CONFIG;");
+                $LOGOUT = 1;
+            print "done!\n" if &Settings::debug;
+        }
 
         $db->do('COMMIT;')if(&Settings::debug);
         print "Commited ALL!
"if(&Settings::debug);      
@@ -930,28 +948,14 @@ sub renumerate {
     print "done!\n" if &Settings::debug;
 }
 
-sub resetCategories {
-    print "Doing wipeCtegories next..." if &Settings::debug;
-    $db->do("DELETE FROM CAT;");
-    $db->do("DROP TABLE CAT;");
-    $LOGOUT = 1;
-    print "done!\n" if &Settings::debug;
-}
 
-sub wipeSystemConfiguration {
-    print "Doing wipeSystemConfiguration next..." if &Settings::debug;
-    $db->do("DELETE FROM CONFIG;");
-    $db->do("DROP TABLE CONFIG;");
-    $LOGOUT = 1;
-    print "done!\n" if &Settings::debug;
-}
 
 #@TODO Needs to be redone, use CNF 2.2
-sub resetSystemConfiguration {
+sub resetSystemConfigurationUPDATING_BELLOW {
 
         open(my $fh, '<', &Settings::logPath.'main.cnf') or die "Can't open ".&Settings::logPath."main.cnf! $!";
         my $db = shift;
-        my ($id,$name, $value, $desc);
+        my ($id, $name, $value, $desc);
         my $inData = 0;
         my $err = "";
         my %vars = {};
@@ -968,7 +972,6 @@ try{
                     my %hsh = $tick[0] =~ m[(\S+)\s*=\s*(\S+)]g;
                     if(scalar(%hsh)==1){
                             for my $key (keys %hsh) {
-
                                     my %nash = $key =~ m[(\S+)\s*\|\$\s*(\S+)]g;
                                     if(scalar(%nash)==1){
                                             for my $id (keys %nash) {
@@ -984,18 +987,18 @@ try{
                                                     my @row = $dbs->fetchrow_array();
                                                     if(scalar @row == 0){
                                                     #The id in config file has precedence to the one in the db,
-                                                    #from a possible previous version.
+                                                    # from a possible previous version.
                                                     $dbs = Settings::selectRecords($db, "SELECT ID FROM CONFIG WHERE ID = $id;");
                                                     @row = $dbs->fetchrow_array();
                                                     if(scalar @row == 0){
                                                             $insert->execute($id,$name,$value,$tick[1]);
                                                     }else{
                                                             #rename, revalue exsisting id
-                                                            $updExs->execute($name,$value,$id);
+                                                            $updExs->execute($name, $value, $id);
                                                         }
                                                     }
                                                     else{
-                                                            $update->execute($value,$id);
+                                                            $update->execute($value, $id);
                                                     }
                                                 }
                                             }
@@ -1033,6 +1036,84 @@ try{
  }
 }
 
+sub resetSystemConfiguration {
+        my ($id, $name, $value, $desc, $db) = shift;
+        my $cnf = new CNFParser(&Settings::logPath.'main.cnf');        
+        my $inData = 0;
+        my $err = "";
+        my %vars = {};
+        my @lines = split('\n',$cnf->anon('CONFIG'));        
+try{
+        my $insert = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)');
+        my $update = $db->prepare('UPDATE CONFIG SET VALUE=? WHERE ID=?;');
+        my $updExs = $db->prepare('UPDATE CONFIG SET NAME=?, VALUE=? WHERE ID=?;');        
+        foreach (my $line = @lines) {            
+            my @tick = split("`",$line);
+            if(scalar(@tick)==2){
+                    #Specification Format is: ^{id}|{property}={value}`{description}\n
+                        #There is no quoting necessary unless capturing spaces or tabs for value!
+                    my %hsh = $tick[0] =~ m[(\S+)\s*=\s*(\S+)]g;
+                    if(scalar(%hsh)==1){
+                            for my $key (keys %hsh) {
+                                    my %nash = $key =~ m[(\d+)\s*\|\$\s*(\S+)]g; # {id}|{property} <- is the key.
+                                    if(scalar(%nash)==1){
+                                            for my $id (keys %nash) {
+                                                $name  = $nash{$id};
+                                                $value = $hsh{$key};  # <- {value}.
+                                                if($vars{$id}){
+            $err .= "UID{$id} taken by $vars{$id}-> $line\n";
+                                                }
+                                                else{
+                                                    $dbs = Settings::selectRecords($db,
+                                                        "SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG WHERE NAME LIKE '$name';");                                                    
+                                                    my @row = $dbs->fetchrow_array();
+                                                    if(scalar @row == 0){
+                                                    #The id in config file has precedence to the one in the db,
+                                                    # from a possible previous version.
+                                                    $dbs = Settings::selectRecords($db, "SELECT ID FROM CONFIG WHERE ID = $id;");
+                                                    @row = $dbs->fetchrow_array();
+                                                    if(scalar @row == 0){
+                                                            $insert->execute($id,$name,$value,$tick[1]);
+                                                    }else{
+                                                            #rename, revalue exsisting id
+                                                            $updExs->execute($name, $value, $id);
+                                                        }
+                                                    }
+                                                    else{
+                                                            $update->execute($value, $id);
+                                                    }
+                                                }
+                                            }
+                                    }else{
+            $err .= "Invalid, specced {uid}|{setting}`{description}-> $line\n";
+                                    }
+
+                            }#rof
+                    }
+                    else{
+            $err .= "Invalid, specced entry -> $line\n";
+                    }
+
+            }            
+            elsif(length($line)>0){
+                if(scalar(@tick)==1){
+                        $err .= "Corrupt entry, no description supplied -> $line\n";
+                }
+                else{
+                    $err .= "Corrupt Entry -> $line\n";
+                }
+            }
+        }
+        die "Configuration script ".&Settings::logPath."main.cnf' contains errors." if $err;        
+        Settings::getConfiguration($db);        
+ } catch{
+      print $cgi->header;
+        print "SERVER ERROR![id:$id,name:$name,value:$value]->$@
 ".$_."
$err
";
+      print $cgi->end_html;
+      exit;
+ }
+}
+
 sub logout {
     Settings::session()->delete();
     Settings::session()->flush();
@@ -1352,7 +1433,6 @@ catch{
 }
 
 package DBMigStats {
-
     
     sub new {
         my $class = shift;
diff --git a/htdocs/cgi-bin/login_ctr.cgi b/htdocs/cgi-bin/login_ctr.cgi
index d1733f4..4fbdbd5 100755
--- a/htdocs/cgi-bin/login_ctr.cgi
+++ b/htdocs/cgi-bin/login_ctr.cgi
@@ -255,11 +255,17 @@ sub checkCreateTables {     my ($pst, $sql,$rv, $changed) = 0;
     %curr_tables = %{Settings::schema_tables($db)};
 
     if($curr_tables{'CONFIG'}) {
-        #Set changed if has configuration data been wiped out.
-        $changed = 1 if Settings::countRecordsIn($db, 'CONFIG') == 0;
+        #Set changed if the configuration data has been wiped out, i.e. by db fix routines.        
         $pst = Settings::selectRecords($db,"SELECT NAME, VALUE FROM CONFIG;");
-        while(my @r = $pst->fetchrow_array()){
-              $curr_config{$r[0]} = $r[1];
+        my @r = $pst->fetchrow_array();
+        if(@r){
+           do { $curr_config{$r[0]} = $r[1] }
+           while(@r = $pst->fetchrow_array())
+        }else{
+               if(!&Settings::loadReserveAnons){
+                   print "No meta file found, recreate of config is from scratch.\n";
+               }
+               $changed = 1;
         }
     }
     else{
@@ -545,7 +551,7 @@ sub checkCreateTables {     my ($pst, $sql,$rv, $changed) = 0;
             Settings::configProperty($db, $did>0?$did:0, 'RELEASE_VER', $SCRIPT_RELEASE);
             Settings::toLog($db, "Upgraded Life Log from v.$dnm to v.$SCRIPT_RELEASE version, this is the $pv upgrade.") if $pv;
         }
-        &populate($db);
+        populate($db);
     }
     Settings::toLog($db, "Log accessed by $alias.") if(Settings::trackLogins());
     #
@@ -803,12 +809,12 @@ $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n";
                                     }
                     }elsif($inData && length($line)>0){
 
-                                        if(scalar(@tick)==1){
-                                            $err .= "Corrupt Entry, (where is '\`' backtick for description?) -> $line\n";
-                                        }
-                                        else{
-                                            $err .= "Corrupt Entry -> $line\n";
-                                        }
+                            if(scalar(@tick)==1){
+                                $err .= "Corrupt Entry, (where is '\`' backtick for description?) -> $line\n";
+                            }
+                            else{
+                                $err .= "Corrupt Entry -> $line\n";
+                            }
 
                     }
         }
diff --git a/htdocs/cgi-bin/system/modules/Settings.pm b/htdocs/cgi-bin/system/modules/Settings.pm
index 0690818..91fce77 100644
--- a/htdocs/cgi-bin/system/modules/Settings.pm
+++ b/htdocs/cgi-bin/system/modules/Settings.pm
@@ -51,6 +51,9 @@ use constant VW_LOG_WITH_EXCLUDES   => 'VW_LOG_WITH_EXCLUDES';
 #
 use constant VW_LOG_OVERRIDE_WHERE  => 'VW_LOG_OVR_WHERE';
 
+use constant META => '^CONFIG_META';
+
+
 # DEFAULT SETTINGS HERE! These settings kick in if not found in config file. i.e. wrong config file or has been altered, things got missing.
 our $RELEASE_VER  = '2.3';
 our $TIME_ZONE    = 'Australia/Sydney';
@@ -104,7 +107,7 @@ our $TIME_ZONE_MAP ="";
 #The all purpose '$S_' class get/setter variable, we do better with less my new variable assignments.
 our $S_ =""; 
 #
-sub anons { keys %anons}
+sub anons {keys %anons}
 #Check call with defined(Settings::anon('my_anon'))
 sub anon {$S_=shift; $S_ = $anons{$S_} if $S_;$S_}
 sub anonsSet {my $a = shift;%anons=%{$a}}
@@ -163,7 +166,7 @@ try {
     $sid     = $sss->id();    
     $alias   = $sss->param('alias');
     $pass    = $sss->param('passw');
-    $pub     = $cgi->param('pub');$pub = $sss->param('pub') if !$pub; #maybe test script session set, sss.
+    $pub     = $cgi->param('pub');$pub = $sss->param('pub') if not $pub; #maybe test script session set in $sss.
     $dbname  = $sss->param('database'); $dbname = $alias if(!$dbname);
 
     ##From here we have data source set, currently Progress DB SQL and SQLite SQL compatible.
@@ -191,10 +194,12 @@ try {
                             last if($line =~ />$/);
                             $S_ .= $line . "\n";
                         }
-                        $anons{'PLUGINS'} = $S_;
+                        anonsSet('PLUGINS', $S_);
                         next;
-                    }     
-                   last if parseAutonom('CONFIG',$line);
+                    }elsif($line =~ /'<<'.META.'<'/p){
+                        anonsSet(META, 1)
+                    }
+                   last if parseAutonom(META, $line);
         }
         close $fh; 
         if(!$SQL_PUB&&$pub ne 'test'){$alias=undef}       
@@ -715,10 +720,14 @@ sub configProperty {
     }
 }
 
+sub connectDBWithAutocommit {
+    connectDB(undef,undef,undef,shift);
+}
 sub connectDB {
-    my ($d,$u,$p) = @_;
-    $u = $alias if(!$u);
-    $p = $alias if(!$p);
+    my ($d,$u,$p,$a) = @_;    
+    $u = $alias if !$u;
+    $p = $alias if !$p;
+    $a = 1      if !$a;
     my $db =$u;
     if(!$d){$db = 'data_'.$u.'_log.db';$d=$u}
     else{   $db = 'data_'.$d.'_log.db';$dbname = $d if !$dbname}
@@ -728,8 +737,8 @@ sub connectDB {
         }else{
             $DSN = $DBI_SOURCE .'dbname='.$DBFILE;        
         }    
-    try{
-        return DBI->connect($DSN, $u, $p, {AutoCommit => 1, RaiseError => 1, PrintError => 0, show_trace=>1});
+    try{        
+        return DBI->connect($DSN, $u, $p, {AutoCommit => $a, RaiseError => 1, PrintError => 0, show_trace=>1});
     }catch{           
        LifeLogException->throw(error=>"
Error->$@

DSN: $DSN
",  show_trace=>1);
     }
@@ -778,5 +787,65 @@ sub loadLastUsedTheme {
     close($fh);    
     &setupTheme;
 }
+sub saveReserveAnons {
+    my $meta = $anons{META}; #since v.2.3
+    my @dr = split(':', dbSrc());
+    LifeLogException->throw(error=>"Meta anon property ^CONFIG_META not found!\n".
+                                   "You possibly have an old main.cnf file there.",  show_trace=>1) if not $meta;
+    try{        
+        my $db = connectDBWithAutocommit(0);
+        open (my $fh, '>', $LOG_PATH.'config_meta_'.(lc($dr[1])).'_'.$dbname) or die $!;
+         print $fh $meta;
+         #It is reserve meta anon type, value (200) is not mutuable, internal.
+         my $dbs = selectRecords($db, "SELECT ID, NAME, VALUE FROM CONFIG WHERE ID >= 200;"); 
+        while(my @r=$dbs->fetchrow_array()){
+            print $fh "$r[0]|$r[1] = $r[2]\n" if $r[0] =~ /^\^/;
+        }
+        close($fh);
+
+    }catch{           
+       LifeLogException->throw(error=>"
Error->$@

DSN: $DSN
",  show_trace=>1);
+    }
+}
+
+sub loadReserveAnons(){
+
+    
+    try{        
+        my @dr = split(':', dbSrc());    
+        my $db = connectDBWithAutocommit(0);
+        my %reservs = ();        
+        my $stInsert = $db->prepare('INSERT INTO CONFIG VALUES(??);');
+        my $stUpdate = $db->prepare('UPDATE CONFIG (NAME, VALUE) WHERE ID =? VALUES(?, ?);');
+        my $dbs = selectRecords($db, "SELECT ID, NAME, VALUE FROM CONFIG WHERE ID >= 200;"); 
+        $db->do('BEGIN TRANSACTION;');
+
+            while(my @r=$dbs->fetchrow_array()){
+            $reservs{$r[1]} = $r[2] if !$reservs{$r[1]}
+            }
+            open (my $fh, '<', $LOG_PATH.'config_meta_'.(lc($dr[1])).'_'.$dbname) or return 0;  
+        
+            while (my $line = <$fh>) {
+                chomp $line;
+                my @p = $line =~ m[(\S+)\s*=\s*(\S+)]g;
+                if(@p>1){
+                    my $existing_val = $reservs{$p[1]};
+                    if(!$existing_val){
+                        $stInsert->execute($p[1], $p[2]);
+
+                    }
+                    elsif($existing_val ne $p[2]){
+                        $stUpdate->execute($p[0], $p[1], $p[2]);
+                    }
+                }
+            }
+        $db->commit();
+        close($fh);
+    }catch{
+       
+       LifeLogException->throw(error=>"
Error->$@

DSN: $DSN
",  show_trace=>1);
+    }
+    return 1;    
+}
 
 1;
\ No newline at end of file
-- 
2.34.1