From e5303657520c02cf0933fa556c6f4d704d513100 Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Wed, 8 Jan 2025 17:45:13 +0100
Subject: [PATCH] - ensured the configuration directives 'server' and
 'username' are never empty

  This patch prevents the software to keeps showing the welcome screen
  when  the main.conf  file  does not  contains at  least  one of  the
  aforementioned directive.

  The dummy server has name "invalid" and supposed to be not used in a
  DNS, see:

  https://en.wikipedia.org/wiki/.invalid
---
 src/constants.lisp              |  6 ++++--
 src/main.lisp                   |  2 +-
 src/package.lisp                |  3 +++
 src/software-configuration.lisp | 18 ++++++++++++++----
 4 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/src/constants.lisp b/src/constants.lisp
index 148a566..217e98b 100644
--- a/src/constants.lisp
+++ b/src/constants.lisp
@@ -125,9 +125,11 @@ General Public License for more details."
 (define-constant +db-file-extension+            "sqlite3"     :test #'string=
   :documentation "the extension filename of the databases")
 
-(define-constant +default-database-username+ "default" :test #'string=)
+(define-constant +default-database-username+    "default"     :test #'string=)
 
-(define-constant +default-database-server-name+ "default" :test #'string=)
+(define-constant +default-database-server-name+ "invalid"     :test #'string=)
+
+(define-constant +invalid-domain-name+          "invalid"     :test #'string=)
 
 (define-constant +json-true+                    "true"        :test #'string=)
 
diff --git a/src/main.lisp b/src/main.lisp
index b65de15..2e0b0c6 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -201,7 +201,7 @@ etc.) happened"
     ;; same        (this       rule        is       enforced        by
     ;; 'swconf:trivial-configuration-checks')
     (when (not (or *gemini-full-screen-mode*
-                   (null (swconf::config-username))))
+                   (swconf:current-server-name-invalid-p)))
       (client:init)
       (if command-line:*fediverse-authorization-code*
           (let ((code (ui:input-dialog-immediate (_ "Authorization code"))))
diff --git a/src/package.lisp b/src/package.lisp
index 4571408..9db295f 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -59,6 +59,7 @@
    :+db-file-extension+
    :+default-database-username+
    :+default-database-server-name+
+   :+invalid-domain-name+
    :+fps+
    :+command-window-height+
    :+starting-init-file+
@@ -1510,6 +1511,8 @@
    :config-notification-icon
    :current-username
    :current-server-name
+   :current-server-name-invalid-p
+   :current-server-name-valid-p
    :all-fediverse-accounts
    :set-current-username-and-server
    :config-password-echo-character
diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp
index 7db3917..6cf270a 100644
--- a/src/software-configuration.lisp
+++ b/src/software-configuration.lisp
@@ -1180,11 +1180,14 @@
                    +key-notification-icon+
                    +key-value+)
 
-(gen-simple-access (server-name)
-                   +key-server+)
 
-(gen-simple-access (username)
-                   +key-username+)
+(defun config-server-name ()
+  (or (access:accesses *software-configuration* +key-server+)
+      (list +default-database-server-name+)))
+
+(defun config-username ()
+  (or (access:accesses *software-configuration* +key-username+)
+      (list +default-database-username+)))
 
 (defun all-fediverse-accounts ()
   (loop for username in (config-username)
@@ -1200,6 +1203,13 @@
 (defun current-server-name ()
   *current-server-name*)
 
+(defun current-server-name-invalid-p ()
+  (string= (current-server-name)
+           constants:+invalid-domain-name+))
+
+(defun current-server-name-valid-p ()
+  (not (current-server-name-invalid-p)))
+
 (defun set-current-username-and-server (&optional username server-name)
   (flet ((set-currents (username server-name)
            (setf *current-username* username)