2
« on: January 01, 2020, 04:11:06 PM »
Here is a updated 8th login dialog with database support for retrieving stored user data.
I currently generate 32 byte random buffer from the cryptographically strong random source and convert it to hex string for the salt. Key for user chosen password is generated with PBKDF2 algorithm using previously randomly generated salt and 10000 iterations as parameters. Username, key and salt is then stored into database.
requires gui
var userdb
defer: auth
{
kind: "edit",
bounds: "edit1.left, lbl2.top, parent.width-20, top+24",
name: "edit2",
max-text: 32,
password-char: "*",
return-pressed: ' auth ,
text-changed: ( "lbl0" g:child "" g:text drop )
} g:new constant edit2-hide-passwd
{
kind: "edit",
bounds: "edit1.left, lbl2.top, parent.width-20, top+24",
name: "edit2",
max-text: 32,
password-char: "",
return-pressed: ' auth ,
text-changed: ( "lbl0" g:child "" g:text drop )
} g:new constant edit2-show-passwd
: alternator \ a -- a[0]
a:shift dup >r
a:push drop r> ;
[ ` edit2-show-passwd ` , ` edit2-hide-passwd ` ] ' alternator curry: next-state
\ auth states
0 constant NOT-FOUND
1 constant USER-PASSWD-MATCH
2 constant USER-PASSWD-FAIL
: auth-from-db \ id passwd -- state
s:len 0 n:= if
2drop
USER-PASSWD-FAIL
;;
then
>r >r
userdb @ "by-id" r> 1 a:close db:bind-exec[]
a:len 0 n:> if
a:open
"salt" m:@ r> swap 10000 cr:genkey
swap "key" m:@ nip b:= if
USER-PASSWD-MATCH
else
USER-PASSWD-FAIL
then
else
drop
rdrop
NOT-FOUND
then
nip ;
: authenticate
"edit2" g:child g:text? >r
"edit1" g:child g:text? r> auth-from-db
[ ( "lbl0" g:child "User not found!" g:text ) ,
( "Authenticated!" . cr bye ) ,
( "lbl0" g:child "User and password don't match!" g:text ) ] swap
caseof drop ;
' authenticate w:is auth
: init
"mytest.db" f:slurp "No database" thrownull
db:open
\ make a prepared statement
"SELECT * FROM user WHERE id=? LIMIT 1" "by-id" db:prep-name
userdb ! "edit1" g:child g:focus ;
{
kind: "win",
buttons: 5,
native-title-bar: false,
title: "Login",
wide: 520,
high: 220,
resizable: false,
center: true,
init: ' init ,
children:
[
{
kind: "box",
name: "frame",
bounds: "0, 0, parent.width, parent.height",
bg: "gray",
children:
[
{
kind: "image",
bounds: "parent.left+10, parent.top+10, left+128, top+128",
img: "8thlogo.png",
name: "logo"
},
{
kind: "label",
fg: "red",
font: 20,
label: "",
bounds: "logo.right+20, parent.top+10, parent.width-10, top+24 ",
justify: ["hcenter"],
name: "lbl0"
},
{
kind: "label",
label: "Username:",
bounds: "logo.right+20, lbl0.bottom+20, left+80, top+24 ",
name: "lbl1"
},
{
kind: "edit",
bounds: "lbl1.right+10, lbl1.top, parent.width-20, top+24",
name: "edit1",
max-text: 32,
return-pressed: ( "edit2" g:child g:focus drop ),
text-changed: ( "lbl0" g:child "" g:text drop )
},
{
kind: "label",
label: "Password:",
bounds: "lbl1.left, lbl1.bottom+10, left+80, top+24",
name: "lbl2"
},
{
kind: "edit",
bounds: "edit1.left, lbl2.top, parent.width-20, top+24",
name: "edit2",
max-text: 32,
password-char: "*",
return-pressed: ' authenticate ,
text-changed: ( "lbl0" g:child "" g:text drop )
},
{
kind: "toggle",
label: "Show password",
adjustwidth: true,
bounds: "edit1.left, lbl2.bottom+20, left+100, top+24",
name: "toggle",
click: ( "edit2" g:child g:text? >r "frame" g:child "edit2" g:-child next-state g:+child "edit2" g:child r> g:text drop )
},
{
kind: "btn",
label: "Login",
bg: "darkgray",
bounds: "lbl2.left, lbl2.bottom+60, edit1.right, top+30",
name: "button",
tooltip: "Login to account",
click: ' authenticate
}
]
}
]
} g:new var, gui
: app:main
( userdb @ db:close ) onexit ;
I currently manually generate user database with the following piece of 8th code:
"Creating a database and adding data:\n" .
\ remove previous db:
"mytest.db" f:rm
\ open a database:
"mytest.db" db:open "Could not create database" thrownull nip
\ create a table
"CREATE TABLE user (id PRIMARY KEY, key, salt)" db:exec
\ make a prepared statement
"INSERT INTO user VALUES (?, ?, ?);" "insert" db:prep-name
: build-params \ id passwd -- a
cr:uuid >r
r@ 10000 cr:genkey
r>
3 a:close ;
\ insert into table using a parameterized statement
\ You could use t:err? to get map of error information
"insert" "jalih" "pa$$w0rd!" build-params null db:bind-exec
"insert" "guest" "guest" build-params null db:bind-exec
"insert" "john" "hard-passwd" build-params null db:bind-exec
"insert" "air" "crack-this" build-params null db:bind-exec
\ and close the database
"All done!\n" .
db:close
bye