Raspberry BASIC

Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - jalih

Pages: [1]
1
Programming Challenges / Re: GUI Login
« on: February 12, 2020, 03:53:39 PM »
Hi all,

I have been busy beta testing next version of 8th. JUCE based gui is out and the new gui is Nuklear based. I have to say, I like it more than JUCE based gui.

Sorry to hear John that you don't have much time for fun programming. I just started writing this;D

2
Programming Challenges / Re: GUI Login
« 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.

Code: [Select]
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:
Code: [Select]
"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

Pages: [1]