From f0b4693924afc5028566ed16af0bf980190e7eec Mon Sep 17 00:00:00 2001 From: wbudic Date: Tue, 17 Aug 2021 18:21:16 +1000 Subject: [PATCH] Started work on updated of config file. Done page layout fixes. --- htdocs/cgi-bin/config.cgi | 263 ++++++++++++---------- htdocs/cgi-bin/login_ctr.cgi | 107 +++++---- htdocs/cgi-bin/main.cgi | 40 ++-- htdocs/cgi-bin/stats.cgi | 144 ++++++++---- htdocs/cgi-bin/system/modules/Settings.pm | 62 +++-- htdocs/cgi-bin/wsrc/main.js | 65 ++++-- 6 files changed, 415 insertions(+), 266 deletions(-) diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index f07206c..e7610c6 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -61,7 +61,7 @@ cats(); ############### processSubmit(); ############### -Settings::getTheme(); +Settings::setupTheme(); Settings::session()->param("theme", Settings::css()); Settings::session()->param("bgcolor", Settings::bgcol()); getHeader(); @@ -116,7 +116,7 @@ my $frmCats = qq( Categories Configuration In -> $dbname  - +
WARNING! Removing or changing categories is permanent! Each category one must have an unique ID. Blank a category name to remove it. LOG records will change to the @@ -160,9 +160,9 @@ while(my @row = $dbs->fetchrow_array()) { $u = "SELECTED" } $v = qq(); + + + ); } elsif($n eq "AUTO_LOGIN"){ my($l,$u)=("",""); @@ -241,20 +241,7 @@ while(my @row = $dbs->fetchrow_array()) { Moon Earth ); - } - elsif($n eq "KEEP_EXCS" or $n eq 'TRACK_LOGINS' or $n eq 'DEBUG'){ - my($l,$u)=("",""); - if($v == 0){ - $l = "SELECTED" - } - else{ - $u = "SELECTED" - } - $v = qq(); - } + } elsif($n eq "RELEASE_VER"){ $REL = qq($n $v @@ -287,15 +274,32 @@ while(my @row = $dbs->fetchrow_array()) { ); } - elsif(!defined(Settings::anon($n))){ #change into settable field to us found here unknown and not anon. + elsif($n eq "KEEP_EXCS" or + $n eq 'TRACK_LOGINS' or + $n eq 'DEBUG' or + $n eq 'TRANSPARENCY' or + $n eq 'AUTO_LOGOFF'){ + my($l,$u)=("",""); + if($v == 0){ + $l = "SELECTED" + } + else{ + $u = "SELECTED" + } + $v = qq(); + } + elsif($n eq 'SUBPAGEDIR' or + !defined(Settings::anon($n))){ #change into settable field to us found here unknown and not anon.'; } - - my $tr = qq( - $n - $v - $d - ); + my $tr = qq( + $n + $v + $d + ); if($i<300){$tbl.=$tr}else{$foot.=$tr} } @@ -305,9 +309,13 @@ $tbl = qq($tbl$foot$REL); #RELEASE VERSION we m my $frmVars = qq(
$tbl - System Settings In -> $dbname  - -

); + System Settings In -> $dbname  + + + Note - Use DB Fix to reset this system settings to factory defaults. + + +
); $tbl = qq( @@ -316,9 +324,9 @@ $tbl = qq(
* DATA FIX *
$tbl - - - + + + - + + Use 'Reset Settings' option to revert to current stored configuration. Changes you made.
+ 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. + WARNING! Checking any of the above extra actions will cause loss + of your changes. Please, export/backup first.
Extra ActionDescription
Reset CategoriesResets Categories to factory values (will initiate logoff).
Reset SettingsResets system settings to default values.
Wipe SettingsResets and wipes system settings for migration (will initiate logoff).
Reset SettingsResets system settings to default values.
Wipe SettingsWipes system settings to be forced from the config file (will initiate logoff).
Reset CategoriesResets Categories to factory values (will initiate logoff).
Delete by Category
$cats
Selects and displays by category logs to delete.
Delete from Date
@@ -326,10 +334,13 @@ my $frmDB = qq(
Data maintenance for -> $dbname 
Perform this change/check in the event of experiencing data problems. Or periodically for data check and maintenance.
- WARNING! Checking any of the above extra actions will cause loss - of your changes. Please, export/backup first.

); @@ -344,6 +355,7 @@ my $frmPASS = qq( Pass change for -> $alias  + WARNING! Changing passwords will make past backups unusuable.
); $frmPASS = qq(Password changing has been dissabled!) if Settings::isProgressDB(); @@ -611,8 +623,8 @@ if($change > 1){ if($cid==$caid || $cnm eq $canm){ - $valid = 0; - last; + $valid = 0; + last; } } @@ -778,6 +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});
         $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.
@@ -806,28 +821,32 @@ try{
             my $st_del = $db->prepare($sql);
             $st_del->execute();
         }
-        print "Doing renumerate next...\n" if &Settings::debug;
-        &renumerate;
-        print "done!\n" if &Settings::debug;
+        
+        &renumerate;        
         print "Doing removeOldSessions next..." if &Settings::debug;
         &Settings::removeOldSessions;
-        print "done!\n " if &Settings::debug;
+        print "done!\n" if &Settings::debug;
+        
         &resetCategories if $rs_cats;
         &resetSystemConfiguration($db) if $rs_syst;
         &wipeSystemConfiguration if $wipe_ss;
 
         $db->do('COMMIT;')if(&Settings::debug);
-        print "Commited ALL!
"if(&Settings::debug); - # $db->disconnect(); - $db = Settings::connectDB(); - $dbs = $db->do("VACUUM;")if(&Settings::debug); - print "Issued VACUUM!
"if(&Settings::debug); + print "Commited ALL!
"if(&Settings::debug); + + if(&Settings::debug){ + $db = Settings::connectDB(); + $dbs = $db->do("VACUUM;"); + print "Issued VACUUM!
"if(&Settings::debug); + } if($LOGOUT){ &logout; } - - exit if(&Settings::debug); + if(&Settings::debug){ + print "
You are in debug mode further actions are halted!
"; + exit; + } } catch{ @@ -840,7 +859,8 @@ sub renumerate { # NOTE: This is most likelly all performed under an transaction. my $sql; - # Fetch list by date identified rtf attached logs, with possibly now an old LID, to be updated to new one. + # Fetch list by date identified rtf attached logs, with possibly now an old LID, to be updated to new one. + print "Doing renumerate next...\n" if &Settings::debug; if(Settings::isProgressDB()){ $sql = "SELECT ID, DATE FROM LOG WHERE RTF > 0;" }else{ @@ -905,24 +925,28 @@ sub renumerate { NOTES.LID = LOG.rowid WHERE LOG.rowid is NULL;"); } if ($dbs) { foreach (@row = $dbs->fetchrow_array()) { - $db->do("DELETE FROM NOTES WHERELID=$row[0];") if $row[0]; # 0 is the place keeper for the shared zero record. + $db->do("DELETE FROM NOTES WHERE LID=$row[0];") if $row[0]; # 0 is the place keeper for the shared zero record, don't delete. }} - + 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 { open(my $fh, '<', &Settings::logPath.'main.cnf') or die "Can't open ".&Settings::logPath."main.cnf! $!"; @@ -931,78 +955,81 @@ sub resetSystemConfiguration { my $inData = 0; my $err = ""; my %vars = {}; - + print "Doing resetSystemConfiguration next..." if &Settings::debug; 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=?;'); $dbs->finish(); - while (my $line = <$fh>) { - chomp $line; - my @tick = split("`",$line); - if(scalar(@tick)==2){ - 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) { - $name = $nash{$id}; - $value = $hsh{$key}; - 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';"); - $inData = 1; - 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); - } - } - } + while (my $line = <$fh>) { + chomp $line; + my @tick = split("`",$line); + if(scalar(@tick)==2){ + 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) { + $name = $nash{$id}; + $value = $hsh{$key}; + 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';"); + $inData = 1; + 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{ - $err .= "Invalid, spec'ed {uid}|{setting}`{description}-> $line\n"; + #rename, revalue exsisting id + $updExs->execute($name,$value,$id); + } } - - }#rof - } - else{ - $err .= "Invalid, speced entry -> $line\n"; + else{ + $update->execute($value,$id); + } + } + } + }else{ + $err .= "Invalid, spec'ed {uid}|{setting}`{description}-> $line\n"; } - }elsif($inData && length($line)>0){ - if(scalar(@tick)==1){ - $err .= "Corrupt Entry, no description supplied -> $line\n"; - } - else{ - $err .= "Corrupt Entry -> $line\n"; - } + }#rof } + else{ + $err .= "Invalid, speced entry -> $line\n"; + } + + } + elsif($line eq '>>'){last} + elsif($inData && length($line)>0){ + if(scalar(@tick)==1){ + $err .= "Corrupt Entry, no description supplied -> $line\n"; + } + else{ + $err .= "Corrupt Entry -> $line\n"; + } + } } - die "Configuration script './main.cnf' [$fh] contains errors." if $err; + die "Configuration script ".&Settings::logPath."main.cnf' contains errors." if $err; close $fh; Settings::getConfiguration($db); + print "done!\n" if &Settings::debug; } catch{ close $fh; print $cgi->header; - print "SERVER ERROR! [id:$id,name:$name,value:$value]/b>
".$_."
$err
"; - print $cgi->end_html; - exit; + print "SERVER ERROR![id:$id,name:$name,value:$value]->$@
".$_."
$err
"; + print $cgi->end_html; + exit; } } @@ -1015,17 +1042,24 @@ sub logout { sub changeSystemSettings { my $updated; + my $id_theme; +try{ + $dbs = Settings::selectRecords($db, "SELECT ID FROM CONFIG WHERE NAME LIKE 'THEME';"); + while (my @r=$dbs->fetchrow_array()){$id_theme=$r[0]} $dbs = Settings::selectRecords($db, "SELECT ID, NAME FROM CONFIG;"); while (my @r=$dbs->fetchrow_array()){ my $var = $cgi->param('var'.$r[0]); if(defined $var){ Settings::configProperty($db, $r[0], undef, $var); $updated = 1; + Settings::saveCurrentTheme($var) if $r[0] == $id_theme; } } Settings::getConfiguration($db) if($updated); +}catch{ + die "\nException\@$0::changeSystemSettings() line ",__LINE__." failed ->\n $@"; #<- It is actually better to die than throw exception traces. Easier to find problem this way. +} } - sub backupDelete { my $n = $cgi->param('bck_del'); @@ -1502,14 +1536,17 @@ sub cats { sub error { my $url = $cgi->url(-path_info => 1); - print qq(

Sorry Encountered Errors

Page -> $url

$ERROR

); - print qq(

CGI Parameters

); - print "
    \n"; + print qq(
    +

    Sorry Encountered Errors

    Page -> $url

    $ERROR

    ; +

    CGI Parameters

    + ); + print "
      "; foreach ($cgi->param){ print '
    1. '.$_.'=='. $cgi->param($_).'
    2. '; } print "
    \n"; - print "Return to -> $url"; + print "
    Return to -> $url

    "; + print $cgi->end_html; $db->disconnect(); exit; diff --git a/htdocs/cgi-bin/login_ctr.cgi b/htdocs/cgi-bin/login_ctr.cgi index 65f8e2a..d1733f4 100755 --- a/htdocs/cgi-bin/login_ctr.cgi +++ b/htdocs/cgi-bin/login_ctr.cgi @@ -36,24 +36,22 @@ my $VW_OVR_SYSLOGS=0; my $VW_OVR_WHERE=""; my $LOGOUT_RELOGIN_TXT='No, no, NO! Log me In Again.'; my $LOGOUT_IFRAME_ENABLED = 0; -my $LOGOUT_IFRAME = qq||; - -try{ +try{ checkAutologinSet(); logout() if($cgi->param('logout')); - if(processSubmit()==0){ - + if(processSubmit()==0){ print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); print $cgi->start_html( -title => "Personal Log Login", -BGCOLOR => &Settings::bgcol, - -script=> [{-type => 'text/javascript', -src => 'wsrc/main.js'}, + -script=> [{-type => 'text/javascript', -src => 'wsrc/main.js'}, {-type => 'text/javascript', -src => 'wsrc/jquery.js'}, {-type => 'text/javascript', -src => 'wsrc/jquery-ui.js'}], - -style => [{-type => 'text/css', -src => "wsrc/".&Settings::css}, + -style => [{-type => 'text/css', -src => "wsrc/".&Settings::css}, {-type => 'text/css', -src => 'wsrc/jquery-ui.css'}, {-type => 'text/css', -src => 'wsrc/jquery-ui.theme.css'}, {-type => 'text/css', -src => 'wsrc/jquery-ui.theme.css'}], @@ -83,12 +81,13 @@ try{ Host -> $hst ); - print qq(

    + print qq(

    -

    Welcome to Life Log

    $frm

    +

    Welcome to Life Log

    $frm

    LifeLog v.).Settings::release().qq(
    -
    ); + +
    ); Settings::printDebugHTML($DBG) if Settings::debug(); print $cgi->end_html; @@ -200,6 +199,7 @@ sub checkAutologinSet { } $db -> disconnect(); } + Settings::loadLastUsedTheme(); } sub checkPreparePGDB { @@ -718,7 +718,7 @@ sub toTokens { return @ret; } - +#@TODO Needs to be redone, use CNF 2.2, see also config.cgi sub populate { my $db = shift; @@ -782,29 +782,29 @@ $err .= "Invalid, spec'ed {uid}|{variable}`{description}-> $line\n"; elsif($tt==0){ $err .= "Invalid, spec'd entry -> $line\n"; }elsif($tt==1){ - my @pair = $tick[0] =~ m[(\S+)\s*\|\s*(\S+\s*\S*)]g; - if ( scalar(@pair)==2 ) { - # In older DB versions the Category name could be different, user modified. - # The unique id and name interwined, changed. Hence we check on name first. - # Then check if the ID is available. If not just skip, the import. Reseting can fix that latter. - if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE NAME LIKE '$pair[1]';")->fetchrow_array()) { - if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE ID = $pair[0];")->fetchrow_array()){ - $DBG .= "cat.ins->".$pair[0].",".$pair[1].",".$tick[1]."\n"; - $insCat->execute($pair[0],$pair[1],$tick[1]); - } - } - $inData = 1; + my @pair = $tick[0] =~ m[(\S+)\s*\|\s*(\S+\s*\S*)]g; + if ( scalar(@pair)==2 ) { + # In older DB versions the Category name could be different, user modified. + # The unique id and name interwined, changed. Hence we check on name first. + # Then check if the ID is available. If not just skip, the import. Reseting can fix that latter. + if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE NAME LIKE '$pair[1]';")->fetchrow_array()) { + if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE ID = $pair[0];")->fetchrow_array()){ + $DBG .= "cat.ins->".$pair[0].",".$pair[1].",".$tick[1]."\n"; + $insCat->execute($pair[0],$pair[1],$tick[1]); } - else { + } + $inData = 1; + } + else { $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n"; - } - }elsif($tt==2){ + } + }elsif($tt==2){ #TODO Do we really want this? Insert into log from config script. } }elsif($inData && length($line)>0){ if(scalar(@tick)==1){ - $err .= "Corrupt Entry, no description supplied -> $line\n"; + $err .= "Corrupt Entry, (where is '\`' backtick for description?) -> $line\n"; } else{ $err .= "Corrupt Entry -> $line\n"; @@ -812,8 +812,7 @@ $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n"; } } - LifeLogException->throw(error=>"Configuration script ".&Settings::logPath."/main.cnf [$fh] contains errors. DSN:". - Settings::dsn()." Err:$err", show_trace=>1) if $err; + LifeLogException->throw(error=>"Configuration script ".&Settings::logPath."/main.cnf contains errors.\nErr:$err", show_trace=>1) if $err; $db->commit(); } @@ -831,40 +830,40 @@ return "SELECT name FROM sqlite_master WHERE type='view' AND name='$name';" sub logout { if(Settings::trackLogins()){ - try{ - $alias = $session->param('alias'); - $passw = $session->param('passw'); - if($alias){ - my $db = Settings::connectDB($DB_NAME, $alias, $passw); - Settings::toLog($db, "Log has properly been logged out by $alias."); - $db->disconnect(); - } - }catch{ - my $err = $@; - my $dbg = "" ; - my $pwd = `pwd`; - $pwd =~ s/\s*$//; - $dbg = "--DEBUG OUTPUT--\n$DBG" if Settings::debug(); - print $cgi->header, - "SERVER ERROR on ".DateTime->now(). - "
    ".$pwd."/$0 -> &".caller." -> [$err]","\n$dbg
    ", - $cgi->end_html; - exit; - } + try{ + $alias = $session->param('alias'); + $passw = $session->param('passw'); + if($alias){ + my $db = Settings::connectDB($DB_NAME, $alias, $passw); + Settings::toLog($db, "Log has properly been logged out by $alias."); + $db->disconnect(); + } + }catch{ + my $err = $@; + my $dbg = "" ; + my $pwd = `pwd`; + $pwd =~ s/\s*$//; + $dbg = "--DEBUG OUTPUT--\n$DBG" if Settings::debug(); + print $cgi->header, + "SERVER ERROR on ".DateTime->now(). + "
    ".$pwd."/$0 -> &".caller." -> [$err]","\n$dbg
    ", + $cgi->end_html; + exit; + } } print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); print $cgi->start_html(-title => "Personal Log Login", -BGCOLOR=>"black", - -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, + -style =>{-type => 'text/css', -src => 'wsrc/'.Settings::css()}, ); $LOGOUT_IFRAME = "" if not $LOGOUT_IFRAME_ENABLED; - print qq(

    You have properly logged out of the Life Log Application!

    + print qq(

    You have properly logged out of the Life Log Application!




    $LOGOUT_IFRAME -
    +
    ); print $cgi->end_html; diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 6c0fa7d..8e6c23f 100755 --- a/htdocs/cgi-bin/main.cgi +++ b/htdocs/cgi-bin/main.cgi @@ -36,7 +36,7 @@ my $VW_PAGE = Settings->VW_LOG; my $sssCDB = $sss->param('cdb'); my ($vmode, $imgw, $imgh ); -if ( !$alias || !$passw) { +if ( !$alias || !$passw ) { print $cgi->redirect("alogin_ctr.cgi?CGISESSID=$sid"); exit; } @@ -84,14 +84,13 @@ my $BGCOL = Settings::bgcol(); my $DEBUG = Settings::debug(); #END OF SETTINGS my $rtf_buffer = 0; -my $BUFFER; -sub toBuf { - $BUFFER .= shift; -} +my ($BUFFER, $D_BUFF); my $lang = Date::Language->new(Settings::language()); my $today = Settings->today(); - +# We buffer the whole page creation, for speed and control send compressed or not to client. +sub toBuf { if($DEBUG){$D_BUFF .= shift}else{$BUFFER .= shift} } + if(!$prm_vc && &Settings::keepExcludes){ if($prm_xc_lst){ Settings::configProperty($db, 201, '^EXCLUDES', $prm_xc_lst); @@ -670,12 +669,12 @@ sub buildLog { $log_output .= qq( $dtf $dth -
    $log
    +
    $log
    $am $ct ); if(!$isPUBViewMode){$log_output .= qq( - + @@ -683,8 +682,7 @@ sub buildLog { )}; - if ( $rtf > 0 ) {#max-width:1000px; - # style="max-height:480px; box-sizing: border-box; padding: 5px; background:#fffafa; overflow-x:scroll;scrollbar-width:none;" + if ( $rtf > 0 ) { $log_output .= qq(
    @@ -789,9 +787,13 @@ $log_output .= qq(
    -
    +
    * LOG ENTRY FORM * @@ -819,7 +821,7 @@ $log_output .= qq( - + @@ -859,6 +861,7 @@ $log_output .= qq(
    Log:
    Log:
    + $tags @@ -867,7 +870,7 @@ $log_output .= qq(
    -
    +
    View By/Search $sp1 @@ -918,7 +921,7 @@ $log_output .= qq( - +
    View by Category:View by Category: