clone url: git://git.m455.casa/bbt
main.fnl
| 1 | #!/usr/bin/env fennel |
| 2 | |
| 3 | (local fennel (require :fennel)) |
| 4 | (local lume (require :lume)) |
| 5 | (local posix (require :posix)) |
| 6 | (local unistd (require :posix.unistd)) |
| 7 | |
| 8 | (local db-file "db.fnl") |
| 9 | (local config-file "config.fnl") |
| 10 | |
| 11 | (local privileges [:create |
| 12 | :delete |
| 13 | :give-privilege |
| 14 | :show-privileges |
| 15 | :show-hash |
| 16 | :show-salt |
| 17 | :show-users]) |
| 18 | |
| 19 | (fn pp [data] (print (fennel.view data))) |
| 20 | |
| 21 | ;;(fn get-char [] |
| 22 | ;; ;(os.execute "stty raw -echo") |
| 23 | ;; (os.execute "/bin/stty -icanon") |
| 24 | ;; (let [char (io.read 1)] |
| 25 | ;; ;(os.execute "stty -raw echo") |
| 26 | ;; (os.execute "/bin/stty icanon") |
| 27 | ;; char)) |
| 28 | |
| 29 | ;; this is soley for using before io.reads |
| 30 | (fn prompt [str] |
| 31 | (io.write str) |
| 32 | (io.flush)) |
| 33 | |
| 34 | (fn prompt-get [str] |
| 35 | (prompt str) |
| 36 | (io.read)) |
| 37 | |
| 38 | (fn write-config [data] |
| 39 | (with-open [fh (io.open config-file :w)] |
| 40 | (fh:write (fennel.view data)))) |
| 41 | |
| 42 | (fn read-config [] |
| 43 | (fennel.dofile config-file)) |
| 44 | |
| 45 | (fn write-db [data] |
| 46 | (with-open [fh (io.open db-file :w)] |
| 47 | (fh:write (fennel.view data)))) |
| 48 | |
| 49 | (fn read-db [] |
| 50 | (fennel.dofile db-file)) |
| 51 | |
| 52 | (fn generate-salt [] |
| 53 | ;; run this seed function before the math.randoms below so the same thing |
| 54 | ;; isn't generated each time the program runs |
| 55 | (math.randomseed (os.time)) |
| 56 | (with-open [fh (io.open "/dev/random" "rb")] |
| 57 | ;; allowed chars according to crypt() docs: |
| 58 | ;; https://luaposix.github.io/luaposix/modules/posix.unistd.html#crypt |
| 59 | ;; table used can also be found here, if you search for "Base64Code": |
| 60 | ;; https://cvsweb.openbsd.org/cgi-bin/cvsweb/src/lib/libc/crypt/bcrypt.c?rev=1.1&content-type=text/x-cvsweb-markup |
| 61 | (let [random-valid-chars (pick-values 1 (string.gsub (fh:read) "[^a-zA-Z0-9./]" "")) |
| 62 | ;; bcrypt requires the salt+hash to be 53 long: |
| 63 | ;; https://man.archlinux.org/man/crypt.5.en#bcrypt |
| 64 | ;; length of salt+hash can also be seen here: |
| 65 | ;; https://en.wikipedia.org/wiki/Bcrypt#Description |
| 66 | salt-length 22] |
| 67 | (if (or (= random-valid-chars "") |
| 68 | (< (length random-valid-chars) salt-length)) |
| 69 | (generate-salt) |
| 70 | (let [method "2b" ;; bcrypt |
| 71 | rounds "15" |
| 72 | salt (string.sub random-valid-chars 1 salt-length)] |
| 73 | (.. :$ method :$ rounds :$ salt)))))) |
| 74 | |
| 75 | (fn authenticate [db user] |
| 76 | (let [attempted-password (prompt-get "enter your password: ") |
| 77 | salt (. db user :password-salt) |
| 78 | hashed-attempt (do (print "checking password...") |
| 79 | (unistd.crypt attempted-password salt)) |
| 80 | hashed-password (. db user :password-hash)] |
| 81 | (if (= hashed-attempt hashed-password) |
| 82 | user |
| 83 | :invalid-password))) |
| 84 | |
| 85 | (fn login [username] |
| 86 | (if (not username) |
| 87 | (login (prompt-get "enter a username: ")) |
| 88 | (let [db (read-db)] |
| 89 | (if (?. db username) |
| 90 | (authenticate db username) |
| 91 | :invalid-user)))) |
| 92 | |
| 93 | (fn has-privilege? [db user privilege] |
| 94 | (lume.find (. db user :privileges) privilege)) |
| 95 | |
| 96 | (fn create-user [caller db user] |
| 97 | (if (has-privilege? db caller :create) |
| 98 | (if (?. db user) |
| 99 | (print "woops, that user already exists.") |
| 100 | (let [password (prompt-get "enter password for the new user: ") |
| 101 | password-salt (generate-salt)] |
| 102 | (set (. db user) {:privileges [:show-users] |
| 103 | : password-salt |
| 104 | :password-hash (do (print "wait one moment...") |
| 105 | (unistd.crypt password password-salt))}) |
| 106 | (write-db db) |
| 107 | (print (string.format "created %s." user)))) |
| 108 | (print "woops: permission denied."))) |
| 109 | |
| 110 | (fn give-user [caller db user privilege] |
| 111 | (if (has-privilege? db caller :give-privilege) |
| 112 | (if (?. db user) |
| 113 | (do (if (lume.find privileges privilege) |
| 114 | (do (table.insert (. db user :privileges) privilege) |
| 115 | (write-db db) |
| 116 | (print (string.format "gave %s the %s privilege." user privilege))) |
| 117 | (print "woops that's not a valid privilege"))) |
| 118 | (print "woops that user doesn't exist.")) |
| 119 | (print "woops: permission denied."))) |
| 120 | |
| 121 | (fn delete-user [caller db user] |
| 122 | (if (has-privilege? db caller :delete) |
| 123 | (if (and (?. db user) |
| 124 | (not (= :admin user)) |
| 125 | (not (= caller user))) ;; lol |
| 126 | (let [answer (prompt-get "are you sure you want to delete this user? (yes/no): ")] |
| 127 | (if (= (string.lower answer) :yes) |
| 128 | (do (tset db user nil) |
| 129 | (write-db db) |
| 130 | (print (string.format "deleted %s." user))) |
| 131 | (print "user deletion cancelled."))) |
| 132 | (print "woops: not a valid user.")) |
| 133 | (print "woops: permission denied."))) |
| 134 | |
| 135 | (fn show-user-privileges [caller db user] |
| 136 | (if (= user caller) |
| 137 | (each [_ priv (ipairs (. db caller :privileges))] |
| 138 | (print priv)) |
| 139 | (if (has-privilege? db caller :show-privileges) |
| 140 | (if (?. db user) |
| 141 | (each [_ priv (ipairs (. db user :privileges))] |
| 142 | (print priv)) |
| 143 | (print "woops, that user doesn't exist.")) |
| 144 | (print "woops: permission denied.")))) |
| 145 | |
| 146 | (fn show-user-hash [caller db user] |
| 147 | (if (= user caller) |
| 148 | (print (. db caller :password-hash)) |
| 149 | (if (has-privilege? db caller :show-hash) |
| 150 | (if (?. db user) |
| 151 | (print (. db user :password-hash)) |
| 152 | (print "woops, that user doesn't exist.")) |
| 153 | (print "woops: permission denied.")))) |
| 154 | |
| 155 | (fn show-user-salt [caller db user] |
| 156 | (if (= user caller) |
| 157 | (print (. db user :password-salt)) |
| 158 | (if (has-privilege? db caller :show-salt) |
| 159 | (if (?. db user) |
| 160 | (print (. db user :password-salt)) |
| 161 | (print "woops, that user doesn't exist.")) |
| 162 | (print "woops: permission denied.")))) |
| 163 | |
| 164 | (fn show-users [caller db] |
| 165 | (if (has-privilege? db caller :show-users) |
| 166 | (each [user _ (pairs db)] |
| 167 | (print user)) |
| 168 | (print "woops: permission denied."))) |
| 169 | |
| 170 | (fn help [] |
| 171 | (print "=== privileges ============") |
| 172 | (each [_ priv (ipairs privileges)] |
| 173 | (print priv)) |
| 174 | (print "") |
| 175 | |
| 176 | (print "=== commands ==============") |
| 177 | (print "create <user>") |
| 178 | (print "delete <user>") |
| 179 | (print "give <privilege> to <user>") |
| 180 | (print "show privileges <user>") |
| 181 | (print "show hash <user>") |
| 182 | (print "show salt <user>") |
| 183 | (print "show users") |
| 184 | (print "switch to <user>") |
| 185 | (print "help") |
| 186 | (print "exit") |
| 187 | (print "===========================")) |
| 188 | |
| 189 | (fn interface-loop [caller] |
| 190 | (let [input (prompt-get (.. caller " > ")) |
| 191 | input-split (lume.split input " ")] |
| 192 | (match input-split |
| 193 | [:give privilege :to user] (give-user caller (read-db) user privilege) |
| 194 | |
| 195 | ;; just here for testing |
| 196 | [:show :privileges user] (show-user-privileges caller (read-db) user) |
| 197 | |
| 198 | ;; just here for testing |
| 199 | [:show :hash user] (show-user-hash caller (read-db) user) |
| 200 | |
| 201 | ;; just here for testing |
| 202 | [:show :salt user] (show-user-salt caller (read-db) user) |
| 203 | |
| 204 | [:switch :to user] (let [login-result (login user)] |
| 205 | (case login-result |
| 206 | :invalid-user (print "invalid user.") |
| 207 | :invalid-password (print "invalid password.") |
| 208 | user (interface-loop user))) |
| 209 | |
| 210 | [:show :users] (show-users caller (read-db)) |
| 211 | |
| 212 | [:create user] (create-user caller (read-db) user) |
| 213 | |
| 214 | [:delete user] (delete-user caller (read-db) user) |
| 215 | |
| 216 | [:help] (help) |
| 217 | |
| 218 | [:exit] (os.exit) |
| 219 | |
| 220 | _ (print (string.format "woops, '%s' isn't a valid command." input))) |
| 221 | |
| 222 | (interface-loop caller))) |
| 223 | |
| 224 | (fn initialize-config [config title] |
| 225 | (tset config :title title)) |
| 226 | |
| 227 | (fn initialize-db [db password] |
| 228 | (let [password-salt (generate-salt)] |
| 229 | (set db.admin {: privileges |
| 230 | : password-salt |
| 231 | :password-hash (do (print "wait one moment...") |
| 232 | (unistd.crypt password password-salt))}))) |
| 233 | |
| 234 | (fn setup [db config] |
| 235 | (let [password (prompt-get "enter an admin password: ") |
| 236 | title (prompt-get "enter a title for your forum: ")] |
| 237 | (initialize-db db password title) |
| 238 | (initialize-config config title) |
| 239 | (write-db db) |
| 240 | (write-config config) |
| 241 | (print (.. "done setting up your forum! next time you run this program, " |
| 242 | "your forum will start :)")))) |
| 243 | |
| 244 | (fn main [] |
| 245 | (if (and (posix.stat db-file) |
| 246 | (posix.stat config-file) |
| 247 | (posix.access db-file :rw) |
| 248 | (posix.access config-file :rw)) |
| 249 | (let [login-result (login nil)] |
| 250 | (case login-result |
| 251 | :invalid-user (print "invalid user.") |
| 252 | :invalid-password (print "invalid password.") |
| 253 | user (interface-loop user))) |
| 254 | (setup {} {}))) |
| 255 | |
| 256 | (main) |