Compare commits

8 Commits

Author SHA1 Message Date
1b33e18be5 Merge branch 'release/1.2' 2025-09-30 23:11:01 +02:00
173793caa3 Preparing v1.2 2025-09-30 23:05:42 +02:00
8698e6b57b Native compilation for windows 2025-09-25 12:22:41 +02:00
386d4f7434 merge conflicts 2025-09-25 10:08:36 +02:00
82b1407489 delete all related with DB tests 2025-09-25 09:55:20 +02:00
5651cc1ab2 Merge pull request 'release/1.0' (#1) from release/1.0 into main
Reviewed-on: #1
2025-09-01 18:38:12 +02:00
96ed6ae1e9 Updated READMEç 2025-09-01 18:33:47 +02:00
d8c3f5ee67 Deleting unfinished features 2025-09-01 10:37:11 +02:00
127 changed files with 49 additions and 1729 deletions

2
.gitignore vendored
View File

@@ -1,5 +1,5 @@
/.clj-kondo/ /.clj-kondo/
/**/.cpcache/ /.cpcache/
/.lsp/ /.lsp/
/target/ /target/
.nrepl-port .nrepl-port

View File

@@ -17,8 +17,6 @@ You can read more about the algorithm here:
## How to use ## How to use
![Use example](use_example.gif)
First, you must have installed a Java Runtime Environment. Check https://adoptium.net/es if you are First, you must have installed a Java Runtime Environment. Check https://adoptium.net/es if you are
unsure how to install. unsure how to install.
@@ -152,7 +150,6 @@ clj-totp.sh import <alias> "<url>"
- [x] Native compilation script corrections - [x] Native compilation script corrections
### v2 ### v2
- [x] Restructurate as a multiproject
- [ ] REST API - [ ] REST API
- [ ] User management - [ ] User management
- [ ] Robust BD backend (H2, datomic, or similar) - [ ] Robust BD backend (H2, datomic, or similar)
@@ -177,14 +174,14 @@ The first step is to install Java JDK, version 11 or newer (version 21 recommend
To execute manually the main function, simple use the `:run` alias: To execute manually the main function, simple use the `:run` alias:
```bash ```clojure
clojure -M:run/cli <commands and parameters> clojure -M:run <commands and parameters>
``` ```
To build the uberjar: To build the uberjar:
```bash ```clojure
clojure -T:build :uber/cli clojure -T:build uber
``` ```
There is a utility script to build a native executable using Graal VM. Please, edit the script and There is a utility script to build a native executable using Graal VM. Please, edit the script and

193
build.clj
View File

@@ -1,174 +1,37 @@
(ns build (ns build
(:refer-clojure :exclude [test]) (:require [clojure.tools.build.api :as b]))
(:require [clojure.tools.build.api :as b]
[clojure.java.io :as io]
[clojure.pprint :as pp]
[clojure.java.basis :as basis]))
(def lib-group "es.rcorral") (def lib 'es.rcorral/clj-totp)
(def artifact-prefix "clj-totp") (def version (format "1.2.%s" (b/git-count-revs nil)))
(def subprojs-base "projects") (def target-dir "target")
(def curr-version (format "2.0.%s" (b/git-count-revs nil))) (def class-dir (str target-dir "/classes"))
(def uber-file (format "target/%s-%s-standalone.jar" (name lib) version))
;; delay to defer side effects (artifact downloads)
(def basis (delay (b/create-basis {:project "deps.edn"})))
;; Builds artifact's full descriptor for each subproject (defn clean [_]
(defn lib [subproj] (b/delete {:path "target"}))
(symbol (str lib-group "/" artifact-prefix "-" subproj )))
(defn compile-java [_]
;; Basis for each subproject, using their own deps.edn (b/javac {:src-dirs ["java"]
;; Injects :extra-deps from :build as additional dependencies :class-dir class-dir
(defn basis [subproj]
(delay (b/create-basis {:project (str subprojs-base "/" subproj "/deps.edn")
;; Inject extra deps as deps
:extra {:deps (get-in (basis/initial-basis) [:aliases :build :extra-deps])}
})))
;; Show basis generated for a subproject
#_{:clojure-lsp/ignore [:clojure-lsp/unused-public-var]}
(defn show-basis [subproj]
(println (with-out-str
(pp/pprint
@(basis subproj)
;(basis/initial-basis)
))))
(comment
(pp/pprint (keys (basis/initial-basis)))
(pp/pprint (:deps (basis/initial-basis)))
(pp/pprint (:libs (basis/initial-basis)))
(pp/pprint (sort (keys (:aliases (basis/initial-basis)))))
(get-in (basis/initial-basis) [:aliases :build :extra-deps])
)
;; Target dir for each subproject
(defn target-dir [subproj]
(str "target/" subproj))
;; Path for compiled classes
(defn class-dir [subproj]
(str (target-dir subproj) "/" "classes"))
;; Jar file for each subproject. :uber type adds -standalone suffix
(defn jar-file [subproj version type]
(format "target/%s-%s-%s%s.jar" artifact-prefix subproj version
(if (= type :uber) "-standalone" "")))
;; Clean target dir for subproject
(defn clean [{:keys [subproj]}]
(b/delete {:path (target-dir subproj)})
(println "Project" subproj "cleaned"))
;; Compile java classes, only if java subdir exists
(defn compile-java [subproj]
(let [java-dir (str subprojs-base "/" subproj "/java")]
(when (.exists (io/file java-dir))
(println "Compiling java code for" subproj)
(b/javac {:src-dirs [java-dir]
:class-dir (class-dir subproj)
:basis @(basis subproj)
:javac-opts ["-source" "11" "--target" "11" "-proc:none"]}))))
;; Create a jar file
(defn jar
"Build a simple jar file, with no dependencies included."
[{:keys [subproj version]
:or {version curr-version}}]
(let [target-dir (target-dir subproj)
class-dir (class-dir subproj)
src-dir (str subprojs-base "/" subproj "/src")
resources-dir (str subprojs-base "/" subproj "/resources")
basis (basis subproj)
jar-file (jar-file subproj version :plain)]
;; Clean only class dir
(b/delete {:path class-dir})
;; Copy code
(b/copy-dir {:src-dirs [src-dir]
:target-dir class-dir})
;; Copy resources
(b/copy-dir {:src-dirs [resources-dir]
:target-dir target-dir})
;; Compile java code, if exists
(compile-java subproj)
;; Build jar
(b/jar {:class-dir class-dir
:basis @basis :basis @basis
:jar-file jar-file :javac-opts ["-source" "11" "--target" "11" "-proc:none"]}))
:lib (lib subproj)
:version version})
(println "Generated jar file:" jar-file)))
;; Create an uber jar, with all dependencies inside
#_{:clojure-lsp/ignore [:clojure-lsp/unused-public-var]} #_{:clojure-lsp/ignore [:clojure-lsp/unused-public-var]}
(defn uber (defn uber [_]
"Build a uberjar with all dependencies included" (clean nil)
[{:keys [subproj version main-ns] (b/copy-dir {:src-dirs ["src"]
:or {version curr-version}}] :target-dir class-dir})
(let [target-dir (target-dir subproj) (b/copy-file {:src "resources/clj-totp.sh"
basis (basis subproj) :target "target/clj-totp.sh"})
class-dir (class-dir subproj) (compile-java nil)
src-dir (str subprojs-base "/" subproj "/src") (b/compile-clj {:basis @basis
resources-dir (str subprojs-base "/" subproj "/resources") :ns-compile '[totp.app]
uber-file (jar-file subproj version :uber)] :class-dir class-dir})
;(println "Using basis: ")(show-basis subproj) (b/uber {:class-dir class-dir
(b/delete {:path class-dir}) :uber-file uber-file
(b/copy-dir {:src-dirs [src-dir] :basis @basis
:target-dir class-dir}) :main 'totp.app}))
(b/copy-dir {:src-dirs [resources-dir]
:target-dir target-dir})
(compile-java subproj)
(b/compile-clj {:basis @basis
:src-dirs [src-dir] :class-dir class-dir})
(b/uber {:class-dir class-dir
:uber-file uber-file
:basis @basis
:main main-ns})
(println "Generated uberjar executable:" uber-file)))
;; Multimethod to get the name of all subdirs in a dir.
;; Accepts strings or files
(defmulti get-subdirs type)
(defmethod get-subdirs
java.lang.String [dir]
(get-subdirs (io/file dir)))
(defmethod get-subdirs
java.io.File [dir]
(if (.isDirectory dir)
(filter #(.isDirectory %) (.listFiles dir))
(println "Directory" subprojs-base "doesn't exists!")))
;; Get the name of all subdir in a given directory
(defn get-subdir-names
"Get a list projects in the 'projects' directory"
[dir-name]
(map #(.getName %) (get-subdirs dir-name)))
(comment
(get-subdirs "projects")
(get-subdirs (io/file "projects"))
(get-subdir-names "projects")
)
;; Generate jar files for all projects
(defn jar-all
"Build jar files for all projects"
[& {:keys [version]
:or {version curr-version}}]
(dorun (map #(jar {:subproj % :version version}) (get-subdir-names subprojs-base))))
(comment
(jar-all )
)

View File

@@ -1,68 +1,24 @@
{:paths ["src" "resources" "target/classes"] {:paths ["src" "resources" "target/classes"]
:deps {org.clojure/clojure {:mvn/version "1.12.1"} :deps {org.clojure/clojure {:mvn/version "1.12.1"}
;; Native image (GraalVM). Tutorial: https://shagunagrawal.me/posts/setup-clojure-with-graalvm-for-native-image/ io.github.clojure/tools.build {:mvn/version "0.10.10"}
com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"} mvxcvi/alphabase {:mvn/version "3.0.185"} ;; https://github.com/greglook/alphabase
;; Local subprojects cli-matic/cli-matic {:mvn/version "0.5.4"} ;; https://github.com/l3nz/cli-matic
clj-totp/core {:local/root "projects/core"} com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"} ;; Tutorial: https://shagunagrawal.me/posts/setup-clojure-with-graalvm-for-native-image/
clj-totp/cli {:local/root "projects/cli"} ;; Protobuf for java
clj-totp/web {:local/root "projects/web"} com.google.protobuf/protobuf-java {:mvn/version "3.25.8"}
clj-totp/gui {:local/root "projects/gui"} ;; Progress bar
com.github.pmonks/spinner {:mvn/version "2.0.284"}
} }
:aliases {;; Execute the app. :aliases {;; Execute the app
:run {:main-opts ["-m" "totp.app"]} :run {:main-opts ["-m" "totp.app"]}
;:run {:exec-fn totp.app/-main}
;; Execute the app (prepared for more subprojects)
:run/cli {:main-opts ["-m" "totp.app"]}
:run/gui {:main-opts ["-m" "totp.gui"]}
;; Kaocha runner. You can use the 'kaocha' wrapper located in ~/bin/kaocha ;; Kaocha runner. You can use the 'kaocha' wrapper located in ~/bin/kaocha
;; Check test.edn for kaocha runner's config :test {:extra-paths ["test"]
:test {:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"} :extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}
lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"}}
:main-opts ["-m" "kaocha.runner"]} :main-opts ["-m" "kaocha.runner"]}
;; Run with clj -T:build function-in-build ;; Run with clj -T:build function-in-build
:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}} :build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
;; Used by all compilations :ns-default build}}}
:extra-deps {clj-totp/core {:local/root "projects/core"}}
:ns-default build}
;; Aliases for easy building
:build/core {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:ns-default build
:exec-fn jar
:exec-args {:subproj "core"}}
:build/cli {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}
clj-totp/core {:local/root "projects/core"}}
:ns-default build
:exec-fn jar
:exec-args {:subproj "cli"}}
:build/web {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:replace-deps {clj-totp/core {:local/root "projects/core"}}
:ns-default build
:exec-fn jar
:exec-args {:subproj "web"}}
:build/gui {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:replace-deps {clj-totp/core {:local/root "projects/core"}}
:ns-default build
:exec-fn jar
:exec-args {:subproj "gui"}}
;; Build the three libraries
:build/all {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:replace-deps {clj-totp/core {:local/root "projects/core"}}
:ns-default build
:exec-fn jar-all}
;; Build uber jar for CLI app
:uber/cli {:deps {io.github.clojure/tools.build {:mvn/version "0.10.10"}}
:ns-default build
:exec-fn uber
:exec-args {:subproj "cli" :main-ns "totp.app"}}}}

View File

@@ -1,34 +0,0 @@
@startuml
' configuration
skinparam linetype ortho
entity "user" as user {
id: number
--
login: varchar(64)
passw: varchar(512)
active: shortint
desc: varchar(512)
config: varchar(512)
}
entity "app" as app {
id: number
--
name: varchar(32)
desc: varchar(512)
secret: varchar(512)
period: int
config: varchar(512)
}
entity "user_app" as user_app {
user_id: number
app_id: number
--
}
user ||--o{ user_app
app ||--o{ user_app
@enduml

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.9 KiB

View File

@@ -24,7 +24,7 @@ for /f "delims=" %%a in ('dir /b /s target\clj-totp-*-standalone.jar') do @set U
echo Created uberjar: %UBERJAR% echo Created uberjar: %UBERJAR%
echo "Creating native image" echo "Creating native image"
cmd /c %NATIVE% -jar %UBERJAR% -o target\%BIN_FILE% -H:+ReportExceptionStackTraces --features=clj_easy.graal_build_time.InitClojureClasses --report-unsupported-elements-at-runtime --verbose --no-fallback -H:ReflectionConfigurationFiles=reflect_config.json -H:-CheckToolchain --initialize-at-build-time=org.fusesource.jansi.Ansi cmd /c %NATIVE% -jar %UBERJAR% -o target\%BIN_FILE% -H:+ReportExceptionStackTraces --features=clj_easy.graal_build_time.InitClojureClasses --report-unsupported-elements-at-runtime --verbose --no-fallback -H:ReflectionConfigurationFiles=reflect_config.json -H:-CheckToolchain
echo Executable created: target\%BIN_FILE%.exe echo Executable created: target\%BIN_FILE%.exe

View File

@@ -14,17 +14,9 @@ $NATIVE -jar target/$UBERJAR -o target/$BIN_FILE\
--verbose --no-fallback\ --verbose --no-fallback\
--features=clj_easy.graal_build_time.InitClojureClasses\ --features=clj_easy.graal_build_time.InitClojureClasses\
--report-unsupported-elements-at-runtime\ --report-unsupported-elements-at-runtime\
--strict-image-heap\
-march=native\
-R:MaxHeapSize=10m\
--initialize-at-build-time=org.fusesource.jansi.Ansi\ --initialize-at-build-time=org.fusesource.jansi.Ansi\
--initialize-at-build-time='org.fusesource.jansi.Ansi$Color'\ #--trace-class-initialization=org.fusesource.jansi.Ansi
--initialize-at-build-time='org.fusesource.jansi.Ansi$Attribute'\
'--initialize-at-build-time=org.fusesource.jansi.Ansi$1'
echo "Executable created on target/$BIN_FILE" echo "Executable created on target/$BIN_FILE"
cp target/$BIN_FILE ~/bin cp target/$BIN_FILE ~/bin
echo "Copied to ~/bin/$BIN_FILE" echo "Copied to ~/bin/$BIN_FILE"
echo "Compress executable for distribution"
xz -fv target/$BIN_FILE

View File

@@ -1,15 +0,0 @@
{:paths ["src" "resources" "target/classes"]
:deps {;clj-totp/core {:local/root "../core"}
org.clojure/clojure {:mvn/version "1.12.1"}
cli-matic/cli-matic {:mvn/version "0.5.4"} ;; https://github.com/l3nz/cli-matic
;; Progress bar
com.github.pmonks/spinner {:mvn/version "2.0.284"}}
:aliases {;; Execute the app
;:run {:main-opts ["-m" "totp.app"]}
;; Kaocha runner. You can use the 'kaocha' wrapper located in ~/bin/kaocha
:test {:extra-paths ["test"]
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}
:main-opts ["-m" "kaocha.runner"]}}}

View File

@@ -1 +0,0 @@
#kaocha/v1 {}

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1,2 +0,0 @@
-m
kaocha.runner

View File

@@ -1,12 +0,0 @@
{:paths ["src" "resources" "target/classes"]
:deps {org.clojure/clojure {:mvn/version "1.12.1"}
mvxcvi/alphabase {:mvn/version "3.0.185"} ;; https://github.com/greglook/alphabase
;; Protobuf for java
com.google.protobuf/protobuf-java {:mvn/version "3.25.8"}
}
:aliases {;; Kaocha runner. You can use the 'kaocha' wrapper located in ~/bin/kaocha
:test {:extra-paths ["test"]
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}
:main-opts ["-m" "kaocha.runner"]}}}

View File

@@ -1,119 +0,0 @@
(ns totp.core
(:require [alphabase.base32 :as b32]
[clojure.math :as m])
(:import (javax.crypto Mac)
(javax.crypto.spec SecretKeySpec)
(java.util Base64 Arrays)
(java.nio ByteBuffer)))
(def ^:private byte-array-type (type (.getBytes "")))
(defn timestamp->steps
"Converts from UNIX timestamp in milliseconds to a number os steps of 's' seconds of duration"
[time, step-size]
(if (or (nil? time) (nil? step-size) (zero? step-size))
0
(int (quot time (* 1000 step-size)))))
(defn bytes-array?
"Return true if x is a byte[]"
[x]
(= byte-array-type (type x)))
(defn get-alg
[alg]
(case alg
"sha1" "HmacSHA1"
"sha256" "HmacSHA256"
"sha512" "HmacSHA512"
""))
(defmulti hmac
"Generates an HMAC. Algorithms supported: sha1, sha256, sha512.
The key and the message can be (both) string or array of bytes, nil otherwise"
(fn [algorithm key message]
(cond
(and (string? key) (string? message) (some? (get-alg algorithm))) :string
(and (bytes-array? key) (bytes-array? message) (some? (get-alg algorithm))) :byte
:else :nil)))
;; By default
(defmethod hmac :nil [_ _ _]
nil)
;; When key and message are strings
(defmethod hmac :string [algorithm key message]
(if (or (empty? key) (empty? message))
""
(let [mac (doto (Mac/getInstance (get-alg algorithm)) (.init (SecretKeySpec. (.getBytes key) (get-alg algorithm))))
hmac-bytes (.doFinal mac (.getBytes message))]
;; Return the Base64 encoded HMAC
(.encodeToString (Base64/getEncoder) hmac-bytes))))
;; When key and message are arrays of bytes
(defmethod hmac :byte [algorithm key message]
(if (nil? message)
(bytes (byte-array 0))
(let [mac (doto (Mac/getInstance (get-alg algorithm)) (.init (SecretKeySpec. key (get-alg algorithm))))
hmac-bytes (.doFinal mac message)]
;; Return the Base64 encoded HMAC
(Base64/getEncoder) hmac-bytes)))
(defn long->bytes
"Converts a long to an array of 8 bytes"
[l]
;;Java equivalent: ByteBuffer.allocate(Long.SIZE / Byte.SIZE).putLong(someLong).array();
(when (integer? l)
(-> (ByteBuffer/allocate (/ Long/SIZE Byte/SIZE))
(.putLong l)
(.array))))
(defn bytes->int
"Converts an array of 4 bytes to an integer"
[bytes]
;;Java equivalent: ByteBuffer.wrap(data).getInt()
(when (some? bytes)
(.getInt (ByteBuffer/wrap bytes))))
(defn get-otp
"Generate an OTP with the given secret (in base32) for the specified timestep"
([secret algorithm digits period] ;;algorithm digits period
(when (and secret period)
(let [step (timestamp->steps (System/currentTimeMillis) period)
k (b32/decode secret)
c (long->bytes step)
hs (hmac algorithm k c)
offset (bit-and (get hs (dec (count hs))) 0x0f) ;; int offset = hs[hs.length-1] & 0xf;
chunk (Arrays/copyOfRange hs offset (+ offset 4)) ;(take 4 (drop offset hs)) ;; byte[] chunk = Arrays.copyOfRange(hs, offset, offset+4)
]
(format (str "%0" digits "d")
(-> chunk
(bytes->int)
(bit-and 0x7fffffff)
(rem (int (m/pow 10 digits))))))))
([secret]
(get-otp secret "sha1" 6 30)))
(defn calculate-offset-millis
[period]
(let [step-millis (* 1000 period)
now (System/currentTimeMillis)]
(int (rem now step-millis))))
(defn calculate-delay-millis
[period]
(let [step-millis (* 1000 period)]
(inc (- step-millis (calculate-offset-millis period)))))
(comment
(do
(println "Now in seconds: " (int (/ (System/currentTimeMillis) 1000)))
(println "Offset in seconds: " (int (/ (calculate-offset-millis 30) 1000)))
(println "Delay in seconds: " (int (/ (calculate-delay-millis 30) 1000))))
)

View File

@@ -1,247 +0,0 @@
(ns totp.data
(:require [clojure.edn :as e]
[clojure.string :as str]
[clojure.java.io :as io]
[clojure.pprint :as pp]
[alphabase.base64 :as b64]
[alphabase.base32 :as b32])
(:import [protoc OtpauthMigration$MigrationPayload]))
(defn join-path
"Joins several subpaths using system's path separator (/ un *NIX and \\ in windows)"
[& col]
(str/join java.io.File/separator col))
(def cfg-path (join-path (System/getProperty "user.home") ".config" "totp"))
(def cfg-file (join-path cfg-path "apps.edn"))
(def cfg-header ";; clj-totp configuration file
;; This file contents a list of maps with :name and :secret entries
;; Secrets must be encoded in BASE32
")
(defn exists-config
"Checks if the config file exists"
[]
(.exists (io/file cfg-file)))
(defn create-cfg-file
"Creates the config file"
[]
(println "Creating " cfg-file)
(io/delete-file cfg-file true)
(io/make-parents cfg-file)
(spit cfg-file cfg-header)
true)
(defn create-cfg?
"Create configuration file if not exists. Overridable with allways = true"
([] (create-cfg? false))
([allways]
(if (or allways (not (exists-config)))
(create-cfg-file)
false)))
(comment
(exists-config)
(create-cfg?))
(defn load-config
"Loads configuration from file"
[]
(e/read-string (slurp cfg-file)))
(defn store-config
"Store configuration to file"
[cfg]
(when cfg
(spit cfg-file (str cfg-header (with-out-str
(binding [pp/*print-right-margin* 50]
(pp/pprint cfg)))))))
(defn delete-app
[cfg name]
(filter #(not= name (:name %)) cfg))
(defn create-app
([name secret] (create-app name secret nil nil "sha1" 6 30))
([name secret user issuer] (create-app name secret user issuer "sha1" 6 30))
([name secret user issuer algorithm digits period]
{:name name :secret secret :user user :issuer issuer :algorithm algorithm :digits digits :period period}))
(defn add-app
([cfg app-map] (apply add-app (cons cfg (vals app-map))))
([cfg name secret] (add-app cfg name secret nil nil "sha1" 6 30))
([cfg name secret user issuer algorithm digits period]
(conj (delete-app cfg name) (create-app name secret user issuer algorithm digits period))))
(defn list-apps
[cfg]
(map :name
(filter #(contains? % :name) cfg)))
(comment
(list-apps (load-config)))
(defn get-app
[cfg name]
(let [app (first (filter #(= name (:name %)) cfg))]
(if app
app
(println "App" name "not found"))))
(comment
(exists-config)
(create-cfg?)
(load-config)
(get-app [{:name "abc" :secret "def"} {:name "my-app" :secret "abc123"} {:name "another app" :secret "ABCDEF1234"}] "my-app2")
(with-out-str
(binding [pp/*print-right-margin* 50]
(pp/pprint [{:name "abc" :secret "def"} {:name "my-app" :secret "abc123"}])))
(store-config [{:name "abc" :secret "def"} {:name "my-app" :secret "abc123"} {:name "another app" :secret "ABCDEF1234"}])
(-> nil
(add-app "app1" "abc123abc123")
(add-app "app2" "abc123abc123")
(add-app "app1" "123456789012")
(store-config))
)
(defmacro with-config
"Loads config file and stores it in a cfg binding.
You can use the cfg var the inner code.
Next example will print config data:
(with-config (println cfg))
Be cafefull: dont use a binding called cfg in any module.
"
[form]
(let [cfg (symbol "cfg")] ;; This symbol will prevent error with qualified in the inner let
`(if (exists-config)
(let [~cfg (load-config)] ;; This is the problematic let binding. See: https://stackoverflow.com/a/15122414
(if (some? ~cfg)
(do ~form)))
(println "Config file not found"))))
(comment
#_{:clj-kondo/ignore [:unresolved-symbol]}
(with-config (first cfg))
(macroexpand-1 '(with-config (first cfg)))
)
(defn url-create->app
"Import data from url using the protocol otpauth://
Example: otpauth://totp/Example:alice@google.com?secret=JBSWY3DPEHPK3PXP&issuer=Example
https://github.com/google/google-authenticator/wiki/Key-Uri-Format"
[name url]
(when (str/starts-with? url "otpauth://")
(let [parts (str/split url #"\?")
meta-parts (str/split (first parts) #"/" -1)
data-parts (str/split (second parts) #"&" -1)
otp-type (nth meta-parts 2)]
(if (not= "totp" otp-type) ;; Only totp is supported
(println "Invalid protocol OTP type:" otp-type)
(let [user-data (str/split (nth meta-parts 3) #":" -1)
issuer (first user-data)
user (second user-data)
;data-map (apply hash-map (flatten (map #(str/split % #"=") data-parts)))
data-map (reduce (fn [acc v] ;; From array to map
(let [[k v] (str/split v #"=")]
(assoc acc (keyword k) v)))
{} data-parts)
secret (:secret data-map)
;;issuer2 (:issuer data-map)
]
(create-app name secret user issuer))))))
(comment
(url-create->app "app1" "otpauth://totp/Reddit:errepunto?issuer=Reddit&secret=3RR2")
(url-create->app "app2" "otpauth://totp/Example:alice@google.com?secret=JBSWY3DPEHPK3PXP&issuer=Example")
(add-app [{:a 1 :b 2}] (url-create->app "app2" "otpauth://totp/Example:alice@google.com?secret=JBSWY3DPEHPK3PXP&issuer=Example"))
)
(defn import-from-url-create
[cfg name url]
(add-app cfg (url-create->app name url)))
(comment
#_{:clj-kondo/ignore [:unresolved-symbol]}
(with-config (import-from-url-create cfg "app1" "otpauth://totp/Example:alice@google.com?secret=JBSWY3DPEHPK3PXP&issuer=Example"))
)
(defn url-export->app
[name url]
(when (some? url)
(let [b64-data (second (str/split url #"=" -1))
data-b (b64/decode b64-data)
parsed (OtpauthMigration$MigrationPayload/parseFrom data-b)
payload (bean (.getOtpParameters parsed 0))
;{:keys [name secret name issuer digitsValue algorithmValue typeValue]} payload
secret-b (:secret payload)
secret (b32/encode (.toByteArray secret-b))
user (:name payload)
issuer (:issuer payload)
algorithm (case (:algorithmValuei payload) 2 "sha256" 3 "sha512" "sha1")
digits (case (:digitsValue payload) 2 8 6)
valid-type (= 2 (:typeValue payload))
]
(println "name:" name "user:" user "issuer:" issuer "digitsValue:" digits "algorithm:" algorithm "valid type?" valid-type)
(if valid-type
(create-app name secret user issuer algorithm digits 30)
(println "Invalid OTP type" (:typeValue payload)))
)))
(comment
(url-export->app "test"
"otpauth-migration://offline?data=CkkKEJ0M4MyHfITKCwCfqPIttjESFHJ1YmVuY2pAMThCMTY5RDVGRjAwGgRTTldMIAEoATACQhMzYjkxMDQxNzI3NzgzNDIzNDYyEAIYASAA"
)
)
(defn import-from-url-export
"Import data from url using the protocol otpauth-migration://
https://alexbakker.me/post/parsing-google-auth-export-qr-code.html"
[cfg name url]
(add-app cfg (url-export->app name url)))
(comment
#_{:clj-kondo/ignore [:unresolved-symbol]}
(with-config (import-from-url-export
cfg
"app2"
"otpauth-migration://offline?data=CkkKEJ0M4MyHfITKCwCfqPIttjESFHJ1YmVuY2pAMThCMTY5RDVGRjAwGgRTTldMIAEoATACQhMzYjkxMDQxNzI3NzgzNDIzNDYyEAIYASAA")
)
)

View File

@@ -1,8 +0,0 @@
#!/usr/bin/env sh
JAVA_EXECUTABLE=java
UBER_JAR=$(realpath clj-totp-*-standalone.jar)
OPTS="-Xms256m -Xmx256m -client -Dclojure.spec.skip-macros=true"
$JAVA_EXECUTABLE $OPTS -jar $UBER_JAR $@

View File

@@ -1 +0,0 @@
#kaocha/v1 {}

View File

@@ -1,7 +0,0 @@
{:paths ["src" "target/classes"]
:deps {;;org.clojure/clojure {:mvn/version "1.12.1"}
cli-matic/cli-matic {:mvn/version "0.5.4"} ;; https://github.com/l3nz/cli-matic
;; GUI
seesaw/seesaw {:mvn/version "1.5.0"}}
}

View File

@@ -1,111 +0,0 @@
(ns totp.gui
#_{:clj-kondo/ignore [:refer-all]}
(:require [totp.core :refer :all]
[totp.data :refer :all]
[clojure.pprint :as pp]
[seesaw.core :refer :all]
[seesaw.mig :refer :all]
[seesaw.clipboard :as cp]
[seesaw.dev :refer :all]))
(defn content-test
[]
(let [choose (fn [e] (alert "I should open a file chooser"))]
(flow-panel
:items ["File" [:fill-h 5]
(text (System/getProperty "user.dir")) [:fill-h 5]
(action :handler choose :name "...")])))
(defn content-test2
[name category date comment]
(mig-panel
:constraints ["wrap 2"
"[shrink 0]20px[200, grow, fill]"
"[shrink 0]5px[]"]
:items [["name:"] [(text (or name ""))]
["category:"] [(text (or category ""))]
["date:"] [(text (or date ""))]
["comment:"] [(text (or comment ""))]]))
(defn copy-handler
"Copies TOTP from text with id field-id, to system clipboard"
[field-id e]
(let [b-name (str "#" field-id)
b-obj (select (to-root e) [(keyword b-name)])
b-text (config b-obj :text)]
(println "Copying text value: " b-text)
(cp/contents! b-text)
))
(defn make-otp-list
[]
(mig-panel
:constraints ["wrap 3"
"[shrink 0]20px[200, grow, fill]10px[shrink 0]"]
:items (let [apps (with-config (filter some? #_{:clj-kondo/ignore [:unresolved-symbol]} cfg))]
(reduce (fn [acc a]
(let [{:keys [name secret algorithm digits period]} a
field-id (str "field-totp-" name)]
(-> acc
(conj [name])
(conj [(text :text (get-otp secret algorithm digits period)
:editable? false
:id field-id)])
(conj [(action :name "copy" :handler (partial copy-handler field-id) :command (str "cmd-" name))]))))
[] apps))))
(comment
(make-otp-list)
(let [apps (with-config (filter some? #_{:clj-kondo/ignore [:unresolved-symbol]} cfg))]
(reduce (fn [acc a]
(let [{:keys [name secret algorithm digits period]} a]
(-> acc
(conj [name])
(conj [(get-otp secret algorithm digits period)]))
))
[] apps))
)
(defn make-frame-content
[]
(border-panel :hgap 10 :vgap 10
:center (make-otp-list)
;:north "NORTH"
;:south "SOUTH"
;:east "EAST"
;:west "WEST"
))
(defn make-frame
"Make main frame's content"
[]
(frame :title "Hello",
;:content "Hello, Seesaw"
:content (make-frame-content)
;:content (content-test2 nil nil nil nil)
;:minimum-size [320 :by 240]
;;:on-close :exit
:on-close :dispose))
(defn -main [& args]
(native!)
(invoke-later
(-> (make-frame)
pack!
show!)))
(comment
;; This kills your REPL connection
(-main)
(show-options (frame))
(show-options (text))
)

View File

@@ -1,18 +0,0 @@
{:paths ["src" "resources" "target/classes"]
:deps {;clj-totp/core {:local/root "../core"}
org.clojure/clojure {:mvn/version "1.12.1"}
;; For SQLite
com.github.seancorfield/next.jdbc {:mvn/version "1.3.1048"}
org.xerial/sqlite-jdbc {:mvn/version "3.50.3.0"}
;; For Datomic local
com.datomic/local {:mvn/version "1.0.291"};; https://docs.datomic.com/datomic-local.html
}
:aliases {;; Execute the app
;:run {:main-opts ["-m" "totp.app"]}
;; Kaocha runner. You can use the 'kaocha' wrapper located in ~/bin/kaocha
:test {:extra-paths ["test"]
:extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}
:main-opts ["-m" "kaocha.runner"]}}}

View File

@@ -1,68 +0,0 @@
(ns totp.db.datomic
(:require [totp.data :as data]
[datomic.client.api :as d]))
(def cfg-path (data/join-path (System/getProperty "user.home") ".config" "totp"))
(def db-path (str cfg-path java.io.File/separator "data"))
(def cfg {:server-type :datomic-local
:system "local-data"
:storage-dir db-path})
(def client (d/client cfg))
;; Schema for our database
(def totp-schema [{:db/ident :app/name
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity
:db/doc "Unique name of the application. Between 2 and 32 chars"
:db.attr/preds (fn [s] (<= 3 (count s) 15))}
{:db/ident :app/desc
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "(optional) Description of the application"}
{:db/ident :app/secret
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "Secret BASE32"}
{:db/ident :app/period
:db/valueType :db.type/long
:db/cardinality :db.cardinality/one
:db/doc "Time slice in seconds (30 by default)"}
{:db/ident :app/config
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "(Optional) Extra config"}
{:db/ident :user/login
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/unique :db.unique/identity
:db/doc "Identifier for the user"}
{:db/ident :user/passwd
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "Password"}
{:db/ident :user/active
:db/valueType :db.type/boolean
:db/cardinality :db.cardinality/one
:db/doc "Is the user active?"}
{:db/ident :user/desc
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "(Optional) Description of the user"}
{:db/ident :user/config
:db/valueType :db.type/string
:db/cardinality :db.cardinality/one
:db/doc "(Optional) Extra config"}
{:db/ident :user/apps
:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many
:db/doc "Applications for this user"}])
(defn init-db
[client]
(d/create-database client {:db-name "totp"}))

Some files were not shown because too many files have changed in this diff Show More