From edab9b2bd8afc59fb177826e29eae0a48ffbc50f Mon Sep 17 00:00:00 2001
From: Rosangela <git@voidptr.net>
Date: Tue, 5 May 2026 22:49:07 +1200
Subject: [PATCH 1/2] Add atomic safe-write, backup retention, and corruption
 recovery

---
 de1plus/machine.tcl    |  5 +++-
 de1plus/safe_load.tcl  | 62 +++++++++++++++++++++++++++++++++++++++++
 de1plus/safe_write.tcl | 63 ++++++++++++++++++++++++++++++++++++++++++
 de1plus/updater.tcl    | 45 +++++-------------------------
 de1plus/utils.tcl      | 21 ++++++++------
 5 files changed, 148 insertions(+), 48 deletions(-)
 create mode 100644 de1plus/safe_load.tcl
 create mode 100644 de1plus/safe_write.tcl

diff --git a/de1plus/machine.tcl b/de1plus/machine.tcl
index 3748ee7e..ffe503dc 100644
--- a/de1plus/machine.tcl
+++ b/de1plus/machine.tcl
@@ -654,7 +654,10 @@ array set ::de1_substate_type_description {
 
 array set ::de1_substate_types_reversed [reverse_array ::de1_substate_types]
 
-array set translation [encoding convertfrom utf-8 [read_binary_file "[homedir]/translation.tcl"]]
+if {[catch {array set translation [encoding convertfrom utf-8 [read_binary_file "[homedir]/translation.tcl"]]}]} {
+    msg -ERROR "translation.tcl is corrupted or unreadable — using empty translations"
+    array set translation {}
+}
 
 proc de1_substate_text {} {
 	set num $::de1(substate)
diff --git a/de1plus/safe_load.tcl b/de1plus/safe_load.tcl
new file mode 100644
index 00000000..00ca56ff
--- /dev/null
+++ b/de1plus/safe_load.tcl
@@ -0,0 +1,62 @@
+# safe_load.tcl — Settings corruption detection and backup recovery
+#
+# Provides load_settings_recover. No package requires, no side effects at source time.
+# Dependencies (read_binary_file, msg, popup) must be defined before calling.
+#
+# Sourced by utils.tcl. Also sourced directly by tests.
+
+# load_settings_recover — Detect corruption in a settings file and recover from .bak
+#
+# Arguments:
+#   fn       - path to the settings file
+#   contents - the already-read contents of the settings file (UTF-8 decoded)
+#
+# Side effects:
+#   - On successful load or recovery: populates ::settings array
+#   - On recovery: calls popup with notification, logs via msg
+#   - On total failure: leaves ::settings empty, logs error
+#
+# Returns a dict:
+#   corrupted  - 1 if corruption was detected, 0 otherwise
+#   recovered  - 1 if successfully recovered from .bak, 0 otherwise
+#   contents   - the effective settings_file_contents (may be "" if recovery failed)
+
+proc load_settings_recover {fn contents} {
+    set corrupted 0
+    set recovered 0
+    set settings_file_contents $contents
+
+    if {[file exists $fn] && [string length $settings_file_contents] == 0} {
+        # File exists but is empty — power loss during write
+        set corrupted 1
+        msg -WARNING "Settings file exists but is empty — likely power loss during write"
+    } elseif {[string length $settings_file_contents] > 0} {
+        if {[catch {array set ::settings $settings_file_contents} err]} {
+            # File exists but content is malformed
+            set corrupted 1
+            msg -WARNING "Settings file is corrupted: $err"
+        }
+    }
+    # Note: if file doesn't exist, settings_file_contents is "" and corrupted stays 0
+    # — falls through to existing fresh-defaults behavior
+
+    if {$corrupted} {
+        set bakfile "${fn}.bak"
+        if {[file exists $bakfile]} {
+            set bak_contents [encoding convertfrom utf-8 [read_binary_file $bakfile]]
+            if {[string length $bak_contents] > 0 && ![catch {array set ::settings $bak_contents}]} {
+                msg -WARNING "Settings recovered from backup file"
+                catch { popup "Settings recovered from backup" }
+                set recovered 1
+            } else {
+                msg -ERROR "Settings backup is also corrupted — using fresh defaults"
+                set settings_file_contents ""
+            }
+        } else {
+            msg -WARNING "Settings corrupted and no backup exists — using fresh defaults"
+            set settings_file_contents ""
+        }
+    }
+
+    return [list corrupted $corrupted recovered $recovered contents $settings_file_contents]
+}
diff --git a/de1plus/safe_write.tcl b/de1plus/safe_write.tcl
new file mode 100644
index 00000000..0eaba811
--- /dev/null
+++ b/de1plus/safe_write.tcl
@@ -0,0 +1,63 @@
+# safe_write.tcl — Atomic file write with backup retention
+#
+# Provides write_file and fast_write_open. No package requires, no side effects
+# at source time. Dependencies (msg) must be defined before calling write_file.
+#
+# Sourced by updater.tcl. Also sourced directly by tests.
+
+proc fast_write_open {fn parms} {
+    set success 0
+    set f 0
+    set errcode [catch {
+        set f [open $fn $parms]
+
+        # Michael argues that there's no need to go nonblocking if you have a write buffer defined.
+        # https://3.basecamp.com/3671212/buckets/7351439/messages/3033510129#__recording_3037579684
+        # so disabling for now, to see if he's right.
+        # fconfigure $f -blocking 0
+
+        # explicitly declare LF as the line feed character, as that's what it is on unix/android/macos - only windows doesn't and it causes issues
+        fconfigure $f -buffersize 1000000 -translation {lf lf}
+        set success 1
+    }]
+
+    if {$errcode != 0} {
+        catch {
+            msg -ERROR "fast_write_open $::errorInfo"
+        }
+    }
+
+    return $f
+    #return ""
+}
+
+proc write_file {filename data} {
+    set success 0
+    set tmpfile "${filename}.tmp"
+    set bakfile "${filename}.bak"
+
+    set errcode [catch {
+        # 1. Write to temp file
+        set fn [fast_write_open $tmpfile w]
+        puts $fn $data
+        close $fn
+
+        # 2. Copy current file to .bak (original stays in place)
+        if {[file exists $filename]} {
+            file copy -force $filename $bakfile
+        }
+
+        # 3. Rename .tmp over target (atomic on POSIX/Android)
+        file rename -force $tmpfile $filename
+
+        set success 1
+    }]
+
+    if {$errcode != 0} {
+        catch { msg -ERROR "write_file '$filename' $::errorInfo" }
+        # Clean up failed temp file if it exists
+        catch { file delete $tmpfile }
+    }
+
+    return $success
+}
diff --git a/de1plus/updater.tcl b/de1plus/updater.tcl
index 2a09f702..587a3e2c 100644
--- a/de1plus/updater.tcl
+++ b/de1plus/updater.tcl
@@ -104,49 +104,18 @@ proc ifexists {fieldname2 {defvalue {}} } {
 
 
 proc fast_write_open {fn parms} {
-    set success 0
-    set f 0
-    set errcode [catch {
-        set f [open $fn $parms]
-
-        # Michael argues that there's no need to go nonblocking if you have a write buffer defined.
-        # https://3.basecamp.com/3671212/buckets/7351439/messages/3033510129#__recording_3037579684
-        # so disabling for now, to see if he's right.
-        # fconfigure $f -blocking 0
-
-        # explicitly declare LF as the line feed character, as that's what it is on unix/android/macos - only windows doesn't and it causes issues
-        fconfigure $f -buffersize 1000000 -translation {lf lf}
-        set success 1
-    }]
-
-    if {$errcode != 0} {
-        catch {
-            msg -ERROR "fast_write_open $::errorInfo"
-        }
-    }
-
-    return $f
-    #return ""
+    # Defined in safe_write.tcl — this stub exists only if safe_write.tcl fails to load
+    error "fast_write_open: safe_write.tcl not loaded"
 }
 
 proc write_file {filename data} {
-    set success 0
-    set errcode [catch {
-        set fn [fast_write_open $filename w]
-        puts $fn $data 
-        close $fn
-        set success 1
-    }]
-
-    if {$errcode != 0} {
-        catch {
-            msg -ERROR "write_file '$filename' $::errorInfo"
-        }
-    }
-
-    return $success
+    # Defined in safe_write.tcl — this stub exists only if safe_write.tcl fails to load
+    error "write_file: safe_write.tcl not loaded"
 }
 
+# Load the real implementations from safe_write.tcl
+source [file join [file dirname [info script]] safe_write.tcl]
+
 proc percent20encode {in} {
     set out $in
     regsub -all " " $out "%20" out
diff --git a/de1plus/utils.tcl b/de1plus/utils.tcl
index 070c95ac..74457f4b 100644
--- a/de1plus/utils.tcl
+++ b/de1plus/utils.tcl
@@ -5,6 +5,9 @@ package require de1_metadata 1.0
 
 package require struct::set  
 
+# Load settings corruption recovery logic
+source [file join [file dirname [info script]] safe_load.tcl]
+
 proc setup_environment {} {
 	global android
 	global undroid
@@ -1197,24 +1200,24 @@ proc load_settings {} {
 
     set tablet_model "[ifexists osbuildinfo(manufacturer)] [ifexists osbuildinfo(model)]"
 
-    set settings_file_contents [encoding convertfrom utf-8 [read_binary_file [settings_filename]]]    
+    set fn [settings_filename]
+    set settings_file_contents [encoding convertfrom utf-8 [read_binary_file $fn]]
 
+    # Corruption detection and .bak recovery (defined in safe_load.tcl)
+    array set recovery_result [load_settings_recover $fn $settings_file_contents]
+    set corrupted $recovery_result(corrupted)
+    set settings_file_contents $recovery_result(contents)
 
-    if {[string length $settings_file_contents] == 0} {
-       
-        # if there are no settings, then set some based on what we know about this machine's settings
-        # nb : we could 
+    if {[string length $settings_file_contents] == 0 && !$corrupted} {
+        # No settings file exists (clean install) — set defaults based on hardware
         if {[ifexists osbuildinfo(product)] == "P80X_EEA"} {
             # this "Teclast" tablet firmware version has an Android metadata configuration bug, and needs 20% larger fonts
             # other Teclast tablets do not have this error.
             # set ::settings(default_font_calibration) 0.6
             # not clear if this is still needed
         }
-    } else {
-        array set ::settings $settings_file_contents
-
+    } elseif {!$corrupted} {
         msg -NOTICE "OS build info: $osbuildinfo_string"
-
     }
 
     if {[ifexists ::settings(tablet_model)] != $tablet_model} {

From 2457986ce042908bef9d4a25e5a02706211ff329 Mon Sep 17 00:00:00 2001
From: Rosangela <git@voidptr.net>
Date: Tue, 5 May 2026 22:49:14 +1200
Subject: [PATCH 2/2] Add tcltest suite for safe-write and recovery

---
 .gitignore                        |   5 +
 de1plus/tests/README.md           |  47 ++++++
 de1plus/tests/test_safe_write.tcl | 248 ++++++++++++++++++++++++++++++
 3 files changed, 300 insertions(+)
 create mode 100644 de1plus/tests/README.md
 create mode 100644 de1plus/tests/test_safe_write.tcl

diff --git a/.gitignore b/.gitignore
index ef9b6459..694ff925 100644
--- a/.gitignore
+++ b/.gitignore
@@ -44,3 +44,8 @@ de1plus/plugins/log_upload/settings.tdb
 /de1plus/tmp/
 /de1plus/profiles_v2/*.json
 /de1plus/history_v2/*.json
+
+# Test artifacts
+/de1plus/tests/test_results.txt
+/de1plus/tests/test_error.txt
+/de1plus/tests/tmp_test_data/
diff --git a/de1plus/tests/README.md b/de1plus/tests/README.md
new file mode 100644
index 00000000..aefe41b4
--- /dev/null
+++ b/de1plus/tests/README.md
@@ -0,0 +1,47 @@
+# DE1 App Tests
+
+Test suite using Tcl's built-in `tcltest` package.
+
+## Running Tests
+
+From the project root (`decent de1/`):
+
+```
+undroidwish-win64.exe run_tests.tcl
+```
+
+On Windows, undroidwish is a GUI-only interpreter and doesn't write to the console.
+Results are written to `de1app/de1plus/tests/test_results.txt`.
+
+After running:
+
+```
+type de1app\de1plus\tests\test_results.txt
+```
+
+Exit code is 0 on success, 1 if any test fails.
+
+## Test Files
+
+| File | Sources | Covers |
+|------|---------|--------|
+| `test_safe_write.tcl` | `safe_write.tcl`, `safe_load.tcl` | Atomic write_file (R1), .bak retention (R2), corruption recovery (R3), translation defensive loading (R3) |
+
+## Architecture
+
+Production code that needs testing lives in small, side-effect-free files:
+
+- `safe_write.tcl` — `fast_write_open` and `write_file` procs
+- `safe_load.tcl` — `load_settings_recover` proc
+
+These are sourced by the main app files (`updater.tcl`, `utils.tcl`) and also sourced
+directly by the test suite.
+
+## Adding Tests
+
+1. Create a new `.tcl` file in this directory.
+2. `package require tcltest 2.5` and `namespace import ::tcltest::*`
+3. Source the production file(s) you're testing (define mocks for their dependencies first).
+4. Use `tcltest::test` for each test case.
+5. Call `cleanupTests` at the end.
+6. Add a `source` call in `run_tests.tcl` if you want the wrapper to run it.
diff --git a/de1plus/tests/test_safe_write.tcl b/de1plus/tests/test_safe_write.tcl
new file mode 100644
index 00000000..1436c7df
--- /dev/null
+++ b/de1plus/tests/test_safe_write.tcl
@@ -0,0 +1,248 @@
+#!/usr/bin/env tclsh
+# test_safe_write.tcl — Tests for safe_write.tcl and safe_load.tcl
+#
+# Run from project root:
+#   undroidwish-win64.exe run_tests.tcl
+#
+# Results written to: de1app/de1plus/tests/test_results.txt
+
+package require tcltest 2.5
+namespace import ::tcltest::*
+
+set test_dir [file dirname [info script]]
+set src_dir [file normalize [file join $test_dir ".."]]
+set results_file [file join $test_dir "test_results.txt"]
+
+# --- Redirect tcltest output to results file from the start ---
+set rf [open $results_file w]
+puts $rf "=== Test Results ==="
+puts $rf "Source: [file join $src_dir safe_write.tcl]"
+puts $rf "Source: [file join $src_dir safe_load.tcl]"
+puts $rf ""
+close $rf
+
+configure -outfile $results_file
+configure -verbose {pass body error skip start}
+
+# --- Mock dependencies (must be defined before sourcing production code) ---
+
+set ::mock_messages {}
+proc msg {args} {
+    lappend ::mock_messages $args
+}
+
+set ::mock_popups {}
+proc popup {text} {
+    lappend ::mock_popups $text
+}
+
+proc read_binary_file {path} {
+    if {![file exists $path]} { return "" }
+    set f [open $path rb]
+    set data [read $f]
+    close $f
+    return $data
+}
+
+# --- Source the real production code ---
+source [file join $src_dir "safe_write.tcl"]
+source [file join $src_dir "safe_load.tcl"]
+
+# --- Test helpers ---
+proc write_test_file {path content} {
+    set f [open $path w]
+    fconfigure $f -translation {lf lf}
+    puts $f $content
+    close $f
+}
+
+set tmp_base [file join $test_dir "tmp_test_data"]
+catch { file delete -force $tmp_base }
+file mkdir $tmp_base
+set ::test_num 0
+
+proc fresh_dir {} {
+    incr ::test_num
+    set d [file join $::tmp_base "t$::test_num"]
+    file mkdir $d
+    return $d
+}
+
+# ============================================================
+# write_file tests (TC-01 through TC-04, TC-10)
+# ============================================================
+
+test tc-01 {Normal write — file created with correct content, no .tmp left} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+} -body {
+    set result [write_file $target "hello world"]
+    list $result \
+         [string trim [read_binary_file $target]] \
+         [file exists "${target}.tmp"]
+} -result {1 {hello world} 0}
+
+test tc-02 {Write to existing file creates .bak with previous content} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+    write_test_file $target "original content"
+} -body {
+    set result [write_file $target "new content"]
+    list $result \
+         [string trim [read_binary_file $target]] \
+         [file exists "${target}.bak"] \
+         [string trim [read_binary_file "${target}.bak"]]
+} -result {1 {new content} 1 {original content}}
+
+test tc-03 {Multiple writes — .bak contains second-to-last content} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+    write_test_file $target "version 1"
+} -body {
+    write_file $target "version 2"
+    write_file $target "version 3"
+    list [string trim [read_binary_file $target]] \
+         [string trim [read_binary_file "${target}.bak"]]
+} -result {{version 3} {version 2}}
+
+test tc-04 {Original survives if .tmp write fails} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+    write_test_file $target "precious data"
+    file mkdir "${target}.tmp"
+} -body {
+    set result [write_file $target "bad write"]
+    list $result [string trim [read_binary_file $target]]
+} -cleanup {
+    catch { file delete -force "${target}.tmp" }
+} -result {0 {precious data}}
+
+test tc-10 {Stale .tmp from previous crash overwritten on next write} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+    write_test_file $target "existing data"
+    write_test_file "${target}.tmp" "stale crash data"
+} -body {
+    set result [write_file $target "fresh data"]
+    list $result \
+         [string trim [read_binary_file $target]] \
+         [file exists "${target}.tmp"]
+} -result {1 {fresh data} 0}
+
+test tc-01b {First write to non-existent file — no .bak created} -setup {
+    set dir [fresh_dir]
+    set target [file join $dir "data.txt"]
+} -body {
+    set result [write_file $target "first write"]
+    list $result \
+         [string trim [read_binary_file $target]] \
+         [file exists "${target}.bak"]
+} -result {1 {first write} 0}
+
+# ============================================================
+# load_settings_recover tests (TC-05 through TC-08)
+# ============================================================
+
+test tc-05 {Empty settings file + valid .bak triggers recovery} -setup {
+    set dir [fresh_dir]
+    set fn [file join $dir "settings.tdb"]
+    set f [open $fn w]; close $f
+    write_test_file "${fn}.bak" "language en\nskin default"
+    catch { unset ::settings }
+    array set ::settings {}
+    set ::mock_popups {}
+} -body {
+    array set r [load_settings_recover $fn ""]
+    list $r(corrupted) $r(recovered) \
+         [info exists ::settings(language)] $::settings(language) \
+         [expr {[llength $::mock_popups] > 0}]
+} -result {1 1 1 en 1}
+
+test tc-06 {Corrupt settings file + valid .bak triggers recovery} -setup {
+    set dir [fresh_dir]
+    set fn [file join $dir "settings.tdb"]
+    write_test_file "${fn}.bak" "theme dark\nscale 1.0"
+    catch { unset ::settings }
+    array set ::settings {}
+} -body {
+    set corrupt "this is not valid tcl list \x7b"
+    array set r [load_settings_recover $fn $corrupt]
+    list $r(corrupted) $r(recovered) \
+         [info exists ::settings(theme)] $::settings(theme)
+} -result {1 1 1 dark}
+
+test tc-07 {Both settings and backup corrupt — fresh defaults, no crash} -setup {
+    set dir [fresh_dir]
+    set fn [file join $dir "settings.tdb"]
+    set f [open $fn w]; close $f
+    set corrupt_bak "also broken \x7b"
+    write_test_file "${fn}.bak" $corrupt_bak
+    catch { unset ::settings }
+    array set ::settings {}
+} -body {
+    array set r [load_settings_recover $fn ""]
+    list $r(corrupted) $r(recovered) [array size ::settings]
+} -result {1 0 0}
+
+test tc-08 {Empty file + valid .bak — recovery with warning logged} -setup {
+    set dir [fresh_dir]
+    set fn [file join $dir "settings.tdb"]
+    set f [open $fn w]; close $f
+    write_test_file "${fn}.bak" "wifi_ssid MyNetwork\nbattery_limit 80"
+    catch { unset ::settings }
+    array set ::settings {}
+    set ::mock_messages {}
+} -body {
+    array set r [load_settings_recover $fn ""]
+    list $r(corrupted) $r(recovered) \
+         [info exists ::settings(wifi_ssid)] $::settings(wifi_ssid) \
+         [expr {[llength $::mock_messages] > 0}]
+} -result {1 1 1 MyNetwork 1}
+
+test tc-extra {File doesn't exist — no corruption, clean install path} -setup {
+    set dir [fresh_dir]
+    set fn [file join $dir "settings.tdb"]
+    catch { unset ::settings }
+    array set ::settings {}
+} -body {
+    array set r [load_settings_recover $fn ""]
+    list $r(corrupted) $r(recovered) [array size ::settings]
+} -result {0 0 0}
+
+# ============================================================
+# Translation defensive loading test (TC-09)
+# ============================================================
+
+test tc-09 {Corrupt translation file doesn't crash — empty translations used} -setup {
+    set dir [fresh_dir]
+    set corrupt "broken \x7b"
+    write_test_file [file join $dir "translation.tcl"] $corrupt
+    array set translation {}
+    set ::mock_messages {}
+} -body {
+    if {[catch {array set translation [encoding convertfrom utf-8 [read_binary_file "[file join $dir translation.tcl]"]]}]} {
+        msg -ERROR "translation.tcl is corrupted or unreadable — using empty translations"
+        array set translation {}
+    }
+    list [array size translation] [expr {[llength $::mock_messages] > 0}]
+} -result {0 1}
+
+test tc-09b {Valid translation file loads correctly} -setup {
+    set dir [fresh_dir]
+    write_test_file [file join $dir "translation.tcl"] "hello Hola\ngoodbye Adios"
+    array set translation {}
+} -body {
+    if {[catch {array set translation [encoding convertfrom utf-8 [read_binary_file "[file join $dir translation.tcl]"]]}]} {
+        msg -ERROR "translation.tcl is corrupted or unreadable — using empty translations"
+        array set translation {}
+    }
+    list [expr {[array size translation] > 0}] [info exists translation(hello)]
+} -result {1 1}
+
+# ============================================================
+# Finalize
+# ============================================================
+cleanupTests
+
+catch { file delete -force $tmp_base }
+exit 0