Share My Creation [B4J] [MySQL] [API] Server (Key + Token) and [B4X] User Login Apps

aeric · Jan 1, 2021

Main (jAPI.b4j):

'Non-UI application (console / server application)
#Region  Project Attributes
    #CommandLineArgs:
    #MergeLibraries: True
#End Region

' MySQL Connector
#AdditionalJar: mysql-connector-java-5.1.37-bin
'#AdditionalJar: postgresql-9.4.1207                ' PostgreSQL
'#AdditionalJar: jtds-1.3.1.jar                     ' SQL Server
 
Sub Process_Globals
    Public srvr As Server
    Public SERVER_PORT As Int
    Public SSL_PORT As Int
    Public ROOT_PATH As String
    Public ROOT_URL As String
    'Private ELEMENT_ROOT As Int
    Public ELEMENT_CONTROLLER As Int
    Public ELEMENT_ACTION As Int
    Public ELEMENT_ID As Int
    Public MAX_ELEMENTS As Int = 4
    Public const VERSION As Float = 1.02
End Sub

Sub AppStart (Args() As String)
    Dim config As Map = Utility.ReadConfig
    SERVER_PORT = config.Get("ServerPort")
    SSL_PORT = config.Get("SSLPort")
    ROOT_PATH = config.Get("ROOT_PATH")
    ROOT_URL = config.Get("ROOT_URL") & ":" & SERVER_PORT

    srvr.Initialize("")
    srvr.Port = SERVER_PORT
    #If RELEASE
    ConfigureSSL(SSL_PORT)
    ROOT_URL = config.Get("ROOT_URL") & ":" & SSL_PORT
    #End If
    srvr.StaticFilesFolder = File.Combine(File.DirApp, "www")
    srvr.SetStaticFilesOptions(CreateMap("dirAllowed": False))

    If ROOT_PATH = "/" Then
        srvr.AddHandler("", "HomeHandler", False) ' using subdomain?
        'ELEMENT_ROOT = 0
        ELEMENT_CONTROLLER = 1
        ELEMENT_ACTION = 2
        ELEMENT_ID = 3
    Else
        srvr.AddHandler(ROOT_PATH, "HomeHandler", False)
        'ELEMENT_ROOT = 1
        ELEMENT_CONTROLLER = 2
        ELEMENT_ACTION = 3
        ELEMENT_ID = 4
        MAX_ELEMENTS = MAX_ELEMENTS + 1
    End If 

    srvr.AddHandler(ROOT_PATH & "test/*", "TestHandler", False)
    srvr.AddHandler(ROOT_PATH & "user/*", "UserHandler", False)
    srvr.AddHandler(ROOT_PATH & "password/*", "PasswordHandler", False)
    srvr.Start
 
    Log($"API server (version = $1.2{VERSION}) is running on port ${srvr.Port}"$)
    #If RELEASE
    Log($"Response will be redirected to port ${srvr.SslPort}"$)
    #End If
    LogDebug($"Open the following URL from your web browser"$)
    LogDebug(ROOT_URL) 
    StartMessageLoop
End Sub

Private Sub ConfigureSSL (SslPort As Int)
    'example of SSL connector configuration
    Dim ssl As SslConfiguration
    ssl.Initialize
    ssl.SetKeyStorePath("/etc/letsencrypt/live/api.puterise.com", "keystore.jks") 'path to keystore file
    ssl.KeyStorePassword = "123456"
    'ssl.KeyManagerPassword = "654321"
    srvr.SetSslConfiguration(ssl, SslPort)
    'add filter to redirect all traffic from http to https (optional)
    srvr.AddFilter("/*", "HttpsFilter", False)
End Sub

HttpsFilter (HttpsFilter.bas):

'Filter class
Sub Class_Globals
 
End Sub

Public Sub Initialize
 
End Sub

'Return True to allow the request to proceed.
Public Sub Filter(req As ServletRequest, resp As ServletResponse) As Boolean
    If req.Secure Then
        Return True
    Else
        resp.SendRedirect(req.FullRequestURI.Replace("http:", "https:") _
       .Replace(Main.srvr.Port, Main.srvr.SslPort))
        Return False
    End If
End Sub

HomeHandler (HomeHandler.bas):

'Handler class
Sub Class_Globals

End Sub

Public Sub Initialize

End Sub

Sub Handle(req As ServletRequest, resp As ServletResponse)
    Dim settings As Map = Utility.ReadSettings
    settings.Put("ROOT_URL", Main.ROOT_URL)
    settings.Put("ROOT_PATH", Main.ROOT_PATH)
    Dim strMain As String = Utility.ReadTextFile("main.html")
    Dim strView As String = Utility.ReadTextFile("index.html") 
    strMain = Utility.BuildView(strMain, strView)
    strMain = Utility.BuildHtml(strMain, settings)
    Utility.ReturnHTML(strMain, resp)
End Sub

UserHandler (UserHandler.bas):

'Handler class
Sub Class_Globals
    Dim Request As ServletRequest
    Dim Response As ServletResponse
    Dim pool As ConnectionPool
End Sub

Public Sub Initialize

End Sub

Sub Handle(req As ServletRequest, resp As ServletResponse)
    Request = req
    Response = resp
    Dim elements() As String = Regex.Split("/", req.RequestURI)
    If elements.Length > Main.MAX_ELEMENTS Or elements.Length = 0 Then
        Response.SendError(500, "Unknown method")
        Return
    Else If elements.Length - 1 = Main.ELEMENT_CONTROLLER Then
        Dim settings As Map = Utility.ReadSettings
        settings.Put("ROOT_URL", Main.ROOT_URL)
        settings.Put("ROOT_PATH", Main.ROOT_PATH)
        Dim strMain As String = Utility.ReadTextFile("main.html")
        Dim strView As String = Utility.ReadTextFile("user.html")
        strMain = Utility.BuildView(strMain, strView)
        strMain = Utility.BuildHtml(strMain, settings)
        Utility.ReturnHTML(strMain, Response)
        Return
    End If

    Dim ActionList As List
    ActionList.Initialize2(Array As String("register", "activate", "login", "getapikey", "gettoken", "getprofile", "view", "update"))
    If ActionList.IndexOf(elements(Main.ELEMENT_ACTION)) > -1 Then
        OpenConnection
    End If

    Select elements(Main.ELEMENT_ACTION)
        Case "connect"
            Utility.ReturnConnect(Response)
        Case "register"
            Register
        Case "activate"
            'If elements.Length < Main.MAX_ELEMENTS Then Return
            If elements.Length - 1 = Main.ELEMENT_ID Then
                Activate(elements(Main.ELEMENT_ID))
            Else
                Activate("")
            End If
        Case "login"
            Login
        Case "getapikey"
            GetApiKey
        Case "gettoken"
            GetToken
        Case "getprofile"
            GetProfile
        Case "view"
            'If elements.Length < Main.MAX_ELEMENTS Then Return
            If elements.Length - 1 = Main.ELEMENT_ID Then
                Select elements(Main.ELEMENT_ID)
                    Case "all"
                        View("all")
                    Case Else
                        View(elements(Main.ELEMENT_ID))
                End Select
            Else
                Response.SendError(500, "Unknown action")
            End If
        Case "update"
            Update
        Case Else
            Response.SendError(500, "Unknown action")
            Return
    End Select
 
    If ActionList.IndexOf(elements(Main.ELEMENT_ACTION)) > -1 Then
        CloseConnection
    End If
End Sub

Sub RequestData As Map
    Try
        Dim data As Map
        Dim ins As InputStream = Request.InputStream
        Dim tr As TextReader
        tr.Initialize(ins)
        Dim json As JSONParser
        json.Initialize(tr.ReadAll)
        data = json.NextObject
    Catch
        LogDebug("[User/RequestData] " & LastException)
    End Try
    Return data
End Sub

Sub OpenConnection
    Try
        Dim config As Map = Utility.ReadConfig
        pool.Initialize(config.Get("DriverClass"), _
        config.Get("JdbcUrl"), _
        config.Get("User"), _
        config.Get("Password"))     
     
        Dim jo As JavaObject = pool
        Dim MaxPoolSize As Int = config.Get("MaxPoolSize")
        jo.RunMethod("setMaxPoolSize", Array(MaxPoolSize))
    Catch
        LogDebug(LastException)
    End Try
End Sub

Sub CloseConnection
    If pool.IsInitialized Then pool.ClosePool
End Sub

Sub WriteErrorLog(Module As String, Message As String)
    Dim con As SQL = pool.GetConnection
    Try
        Dim strSQL As String = $"INSERT
        INTO tbl_error
        (error_text)
        SELECT ?"$
        con.ExecNonQuery2(strSQL, Array As String("[" & Module & "]" & Message))
    Catch
        LogDebug(LastException)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub WriteUserLog(log_view As String, log_type As String, log_text As String, Log_User As String)
    Dim con As SQL = pool.GetConnection
    Try
        Dim strSQL As String = $"INSERT INTO tbl_users_log
        (log_view,
        log_type,
        log_text,
        log_user)
        SELECT ?, ?, ?, ?"$
        con.ExecNonQuery2(strSQL, Array As String(log_view, log_type, log_text, Log_User))
    Catch
        Dim msg_text As String = "[Exception] " & LastException
        WriteErrorLog("WriteUserLog", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub Register
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/register", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim eml As String = Map1.Get("eml")
        Dim pwd As String = Map1.Get("pwd")
        Dim name As String = Map1.Get("name")
             
        If eml = "" Or pwd = "" Or name = "" Then
            msg_text = "[Not set]"
            WriteUserLog("user/register", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
     
        Dim strSQL As String = $"SELECT
        user_id
        FROM tbl_users
        WHERE user_email = ?"$
        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(eml))
        If result.NextRow Then
            msg_text = "[Email Used] " & eml
            WriteUserLog("user/register", "fail", msg_text, 0)
            Utility.ReturnError("Error-Email-Used", Response)
            con.Close
            Return
        Else
            Dim salt As String = Utility.MD5(Rnd(100001, 999999))
            Dim hash As String = Utility.MD5(pwd & salt)
            Dim code As String = Utility.MD5(salt & eml)
            Dim key As String = Utility.SHA1(hash)
            Dim flag As String = "M"
         
            strSQL = $"INSERT INTO tbl_users
            (user_email,
            user_name,
            user_hash,
            user_salt,
            user_api_key,
            user_activation_code,
            user_activation_flag)
            VALUES (?, ?, ?, ?, ?, ?, ?)"$
            con.ExecNonQuery2(strSQL, Array As String(eml, name, hash, salt, key, code, flag))
            Dim user_id As Int = con.ExecQuerySingleResult("SELECT LAST_INSERT_ID()")
            msg_text = "new user"
            WriteUserLog("user/register", "success", msg_text, user_id)
            SendEmail(name, eml, code)
            Utility.ReturnSuccess("success", Response)
            con.Close
            Return
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/register", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub Activate(Code As String)
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strMain As String
    Dim strSQL As String
    Try
        If Code = "" Then
            strMain = $"<h1>Activation</h1>
            <p>Invalid activation code!</p>"$
            Utility.ReturnHTML(strMain, Response)
            con.Close
            Return
        Else If Code = "vhbgroalh90akyyypt0ah3qjo5gpb0bx" Then ' Dummy Code
            strMain = $"<h1>Activation</h1>
            <p>Dummy activation code!</p>"$
            Utility.ReturnHTML(strMain, Response)
            con.Close
            Return
        Else
            strSQL = $"SELECT
            user_id
            FROM tbl_users
            WHERE user_activation_code = ?
            AND user_activation_flag = 'M'"$                     
            Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(Code))
            If result.NextRow Then
                ' Update flag
                strSQL = $"UPDATE tbl_users SET
                user_activation_flag = 'R',
                user_activated_at = now(),
                user_active = 1
                WHERE user_activation_code = ?
                AND user_activation_flag = 'M'"$
                con.ExecNonQuery2(strSQL, Array As String(Code))
             
                msg_text = Code
                WriteUserLog("user/activate", "success", msg_text, 0)
                strMain = $"<h1>Activation</h1>
                <p>Your account is now activated!</p>"$
                Utility.ReturnHTML(strMain, Response)
                con.Close
                Return
            Else
                msg_text = "[Email Used] "
                WriteUserLog("user/activate", "fail", msg_text, 0)
                strMain = $"<h1>Activation</h1>
                <p>Account Not found!</p>"$
                Utility.ReturnHTML(strMain, Response)
                con.Close
                Return
            End If
        End If
    Catch
        WriteErrorLog("user/activate", "[Exception] " & LastException)
        strMain = $"<h1>Activation</h1>
        <p>An error occured!</p>"$
        Utility.ReturnHTML(strMain, Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub Login
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strSQL As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/login", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim eml As String = Map1.Get("eml")
        Dim pwd As String = Map1.Get("pwd")
             
        If eml = "" Or pwd = "" Then
            msg_text = "[Not set]"
            WriteUserLog("user/login", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
         
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        user_name,
        user_email,
        ifnull(user_location, '') AS user_location,
        ifnull(user_token, '') AS user_token,
        ifnull(user_api_key, '') AS user_api_key,
        user_activation_flag
        FROM tbl_users
        WHERE user_email = ?
        AND user_hash = md5(concat(?, user_salt))"$
 
        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(eml, pwd))
        If result.NextRow Then
            If result.GetString("user_activation_flag") = "M" Then
                msg_text = "[Not Activated] " & eml
                WriteUserLog("user/login", "fail", msg_text, result.GetInt("result"))
                Utility.ReturnError("Error-Not-Activated", Response)
                con.Close
                Return
            End If
            ' Update login status
            strSQL = $"UPDATE tbl_users SET
            user_login_count = user_login_count + 1,
            user_last_login_at = now()
            WHERE user_email = ?"$
            con.ExecNonQuery2(strSQL, Array As String(eml))
         
            Dim Map2 As Map
            Map2.Initialize
            For i = 0 To result.ColumnCount - 1
                If result.GetColumnName(i) = "result" Then
                    Map2.Put("result", result.GetInt("result"))
                Else
                    Map2.Put(result.GetColumnName(i), result.GetString2(i))
                End If
            Next
            msg_text = eml
            WriteUserLog("user/login", "success", msg_text, result.GetInt("result"))
            Utility.ReturnJSON(Map2, Response)
        Else
            msg_text = "[Not Found/Wrong Password] " & eml
            WriteUserLog("user/login", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Result", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/login", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub GetApiKey
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strSQL As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/getapikey", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim eml As String = Map1.Get("eml")
        Dim pwd As String = Map1.Get("pwd")
     
        If eml = "" Or pwd = "" Then
            msg_text = "[Not set]"
            WriteUserLog("user/getapikey", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
         
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        ifnull(user_api_key, '') AS user_api_key
        FROM tbl_users
        WHERE user_email = ?
        AND user_hash = md5(concat(?, user_salt))"$
 
        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(eml, pwd))
        If result.NextRow Then
            msg_text = "[Existing key] "
            If result.GetString("user_api_key") = "" Then
                Dim apikey As String = Utility.SHA1(Rnd(100001, 999999))
                ' Update apikey
                strSQL = $"UPDATE tbl_users SET
                user_api_key = ?,
                user_last_login_at = now(),
                modified_at = now()
                WHERE user_email = ?"$
                con.ExecNonQuery2(strSQL, Array As String(apikey, eml))
                msg_text = "[New key] "
            End If

            Dim Map2 As Map
            Map2.Initialize
            Map2.Put("result", result.GetInt("result"))
            Map2.Put("message", "success")
            Map2.Put("user_api_key", apikey)
            WriteUserLog("user/getapikey", "success", msg_text & eml, result.GetInt("result"))
            Utility.ReturnJSON(Map2, Response)
        Else
            msg_text = "[Not Found] " & eml
            WriteUserLog("user/getapikey", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Result", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/getapikey", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub GetToken
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strSQL As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/gettoken", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim apikey As String = Map1.Get("key")
     
        If apikey = "" Then
            msg_text = "[Not set]"
            WriteUserLog("user/gettoken", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
         
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        ifnull(user_token, '') AS user_token
        FROM tbl_users
        WHERE user_api_key = ?"$
 
        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(apikey))
        If result.NextRow Then
            Dim token As String = result.GetString("user_token")
            msg_text = "[Existing token] "
            If token = "" Then
                Dim newtoken As String = Utility.SHA1(Rnd(100001, 999999))
                ' Update token
                strSQL = $"UPDATE tbl_users SET
                user_token = ?,
                user_last_login_at = now(),
                modified_at = now()
                WHERE user_api_key = ?"$
                con.ExecNonQuery2(strSQL, Array As String(newtoken, apikey))
                token = newtoken
                msg_text = "[New token] "
            End If

            Dim Map2 As Map
            Map2.Initialize
            Map2.Put("result", result.GetInt("result"))
            Map2.Put("message", "success")
            Map2.Put("user_token", token)
            WriteUserLog("user/gettoken", "success", msg_text & "key: " & apikey, result.GetInt("result"))
            Utility.ReturnJSON(Map2, Response)
        Else
            msg_text = "[Not Found] " & apikey
            WriteUserLog("user/gettoken", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Result", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/gettoken", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub GetProfile
    Dim con As SQL = pool.GetConnection
    Dim result As ResultSet
    Dim msg_text As String
    Dim strSQL As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/view", "fail", msg_text, 0)
            Utility.ReturnError("Error-Not-Authorized", Response)
            If con <> Null And con.IsInitialized Then con.Close
            Return
        End If

        Dim token As String = Map1.Get("token")
        LogDebug(token)
        If token = "" Then
            Utility.ReturnError("Error-Not-Authorized", Response)
            If con <> Null And con.IsInitialized Then con.Close
            Return
        End If
     
        ' Update last login
        strSQL = $"UPDATE tbl_users SET
                user_last_login_at = now()
                WHERE user_token = ?"$
        con.ExecNonQuery2(strSQL, Array As String(token))
     
        ' Check Login session token
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        user_name,
        user_email,
        ifnull(user_location, '') AS user_location
        FROM tbl_users
        WHERE user_token = ?"$
        result = con.ExecQuery2(strSQL, Array As String(token))
        Dim List2 As List
        List2.Initialize
        Do While result.NextRow
            Dim Map2 As Map
            Map2.Initialize
            For i = 0 To result.ColumnCount - 1
                If result.GetColumnName(i) = "result" Then
                    Map2.Put("result", result.GetInt("result"))
                Else
                    Map2.Put(result.GetColumnName(i), result.GetString2(i))
                End If
            Next
            List2.Add(Map2)
        Loop
        If List2.Size > 0 Then
            Utility.ReturnJSON2(List2, Response)
        Else
            Utility.ReturnError("Error-Invalid-Token", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/getprofile", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub View(id As String)
    Dim con As SQL = pool.GetConnection
    Dim result As ResultSet
    Dim msg_text As String
    Dim strSQL As String 
    Try
        If id = "" Then
            Utility.ReturnError("Error-No-Value", Response)
            If con <> Null And con.IsInitialized Then con.Close
            Return
        End If
     
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/view", "fail", msg_text, 0)
            Utility.ReturnError("Error-Not-Authorized", Response)
            If con <> Null And con.IsInitialized Then con.Close
            Return
        End If

        Dim token As String = Map1.Get("token")
        LogDebug(token)
        If token = "" Then
            Utility.ReturnError("Error-Not-Authorized", Response)
            If con <> Null And con.IsInitialized Then con.Close
            Return
        End If
     
        ' Check Login session token
        strSQL = "SELECT user_id FROM tbl_users WHERE user_token = ?"
        result = con.ExecQuery2(strSQL, Array As String(token))
        If result.NextRow Then
            strSQL = $"UPDATE tbl_users SET
                user_last_login_at = now()
                WHERE user_token = ?"$
            con.ExecNonQuery2(strSQL, Array As String(token))
         
            ' Query users logged in within 10 minutes
            strSQL = $"SELECT
            user_id AS `result`,
            'success' AS `message`,
            user_name,
            user_email,
            ifnull(user_location, '') AS user_location,
            CASE
            WHEN (user_last_login_at > now()-600) THEN 'Y'
            ELSE 'N' END AS `online`
            FROM tbl_users
            WHERE EXISTS
            (SELECT user_id
            FROM tbl_users
            WHERE user_token = ?)"$
            If id <> "all" Then
                strSQL = strSQL & " AND user_id = ?"
                ' Check id is numeric?
                result = con.ExecQuery2(strSQL, Array As String(token, id))
            Else
                result = con.ExecQuery2(strSQL, Array As String(token))
            End If
     
            Dim List2 As List
            List2.Initialize
            Do While result.NextRow
                Dim Map2 As Map
                Map2.Initialize
                For i = 0 To result.ColumnCount - 1
                    If result.GetColumnName(i) = "result" Then
                        Map2.Put("result", result.GetInt("result"))
                    Else
                        Map2.Put(result.GetColumnName(i), result.GetString2(i))
                    End If
                Next
                List2.Add(Map2)
            Loop
            Utility.ReturnJSON2(List2, Response)
        Else
            Utility.ReturnError("Error-Invalid-Token", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/view", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

' only update own profile, edit other users is restricted
Sub Update
    Dim con As SQL = pool.GetConnection
    Dim result As ResultSet
    Dim strSQL As String
    Dim msg_text As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("user/update", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
             
        Dim key As String = Map1.Get("key")
        Dim token As String = Map1.Get("token")
        Dim user_name As String = Map1.Get("user_name")
        Dim user_location As String = Map1.Get("user_location")
        If token = "" Or key = "" Then
            Utility.ReturnError("Error-Not-Authorized", Response)
            con.Close
            Return
        End If
        If user_name = "" Or user_location = "" Then
            msg_text = "[Not Set]"
            WriteUserLog("user/update", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
     
        ' Check Login session token
        strSQL = "SELECT user_id FROM tbl_users WHERE user_token = ?"
        result = con.ExecQuery2(strSQL, Array As String(token))
        If result.NextRow Then
            msg_text = "key: " & key
            strSQL = $"SELECT user_id AS result
            FROM tbl_users
            WHERE EXISTS (SELECT user_id FROM tbl_users WHERE user_api_key = ?)"$
            result = con.ExecQuery2(strSQL, Array As String(key))
            If result.NextRow Then
                strSQL = $"UPDATE tbl_users SET
                user_name = ?,
                user_location = ?,
                user_last_login_at = now(),
                modified_at = now()
                WHERE user_api_key = ?"$
                con.ExecNonQuery2(strSQL, Array As String(user_name, user_location, key))
         
                WriteUserLog("user/update", "success", msg_text, result.GetInt("result"))
                Utility.ReturnSuccess("success", Response)
            Else
                WriteUserLog("user/update", "fail", msg_text, 0)
                Utility.ReturnError("Error-No-Result", Response)
            End If
        Else
            Utility.ReturnError("Error-Invalid-Token", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("user/update", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub SendEmail(user_name As String, user_email As String, activation_code As String)
    Dim smtp As SMTP
    Try
        Dim settings As Map = Utility.ReadSettings
        Dim APP_TRADEMARK As String = settings.Get("APP_TRADEMARK")
        Dim SMTP_USERNAME As String = settings.Get("SMTP_USERNAME")
        Dim SMTP_PASSWORD As String = settings.Get("SMTP_PASSWORD")
        Dim SMTP_SERVER As String = settings.Get("SMTP_SERVER")
        Dim SMTP_USESSL As String = settings.Get("SMTP_USESSL")
        Dim SMTP_PORT As Int = settings.Get("SMTP_PORT")
        Dim ADMIN_EMAIL As String = settings.Get("ADMIN_EMAIL")

        smtp.Initialize(SMTP_SERVER, SMTP_PORT, SMTP_USERNAME, SMTP_PASSWORD, "SMTP")
        If SMTP_USESSL.ToUpperCase = "TRUE" Then smtp.UseSSL = True Else smtp.UseSSL = False
        smtp.HtmlBody = True
        LogDebug("Sending email...")
        smtp.Sender = SMTP_USERNAME
        smtp.To.Add(user_email)
        smtp.AuthMethod = smtp.AUTH_LOGIN
        smtp.subject = APP_TRADEMARK
        smtp.body = $"Hi ${user_name},<br />
        Please click on this link to finish the registration process:<br />
        <a href="${Main.ROOT_URL}/user/activate/${activation_code}"
        id="activate-link" title="activate" target="_blank">${Main.ROOT_URL}/user/activate/${activation_code}</a><br />
        <br />
        If the link is not working, please copy the url to your browser.<br />
        <br />
        Regards,<br />
        <em>${APP_TRADEMARK}</em>"$ 
        LogDebug(smtp.body)
     
        Dim sm As Object = smtp.Send
        Wait For (sm) SMTP_MessageSent (Success As Boolean)
        If Success Then
            LogDebug("Message sent successfully")
        Else
            LogDebug("Error sending message")
            LogDebug(LastException)
        End If
     
        'Notify site admin of new sign up
        smtp.Sender = SMTP_USERNAME
        smtp.To.Add(ADMIN_EMAIL)
        smtp.AuthMethod = smtp.AUTH_LOGIN
        smtp.HtmlBody = False
        smtp.subject = "New registration"
        smtp.body = $"Hi Admin,${CRLF}
        ${user_name} has registered using our app."$
     
        Dim sm As Object = smtp.Send
        Wait For (sm) SMTP_MessageSent (Success As Boolean)
        If Success Then
            LogDebug("Message sent to Admin successfully")
        Else
            LogDebug("Error sending message to Admin")
            LogDebug(LastException)
        End If
    Catch
        LogDebug(LastException)
        Utility.ReturnError("Error-Send-Email", Response)
    End Try
End Sub

PasswordHandler (PasswordHandler.bas):

'Handler class
Sub Class_Globals
    Dim Request As ServletRequest
    Dim Response As ServletResponse
    Dim pool As ConnectionPool
End Sub

Public Sub Initialize
    
End Sub

Sub Handle(req As ServletRequest, resp As ServletResponse)
    Request = req
    Response = resp
    Dim elements() As String = Regex.Split("/", req.RequestURI)
    If elements.Length > Main.MAX_ELEMENTS Or elements.Length = 0 Then
        Response.SendError(500, "Unknown method")
        Return
    Else If elements.Length - 1 = Main.ELEMENT_CONTROLLER Then
        Dim settings As Map = Utility.ReadSettings
        settings.Put("ROOT_URL", Main.ROOT_URL)
        settings.Put("ROOT_PATH", Main.ROOT_PATH)
        Dim strMain As String = Utility.ReadTextFile("main.html")
        Dim strView As String = Utility.ReadTextFile("password.html")
        strMain = Utility.BuildView(strMain, strView)
        strMain = Utility.BuildHtml(strMain, settings)
        Utility.ReturnHTML(strMain, Response)
        Return
    End If

    Dim ActionList As List
    ActionList.Initialize2(Array As String("change", "reset", "confirmreset"))
    If ActionList.IndexOf(elements(Main.ELEMENT_ACTION)) > -1 Then
        OpenConnection
    End If
    
    Select elements(Main.ELEMENT_ACTION)
        Case "change"
            ChangePassword
        Case "reset"
            ResetPassword
        Case "confirmreset"
            If elements.Length < Main.MAX_ELEMENTS Then Return
            ConfirmReset(elements(Main.ELEMENT_ID))
        Case Else
            Response.SendError(500, "Unknown action")
            Return
    End Select
    
    If ActionList.IndexOf(elements(Main.ELEMENT_ACTION)) > -1 Then
        CloseConnection
    End If
End Sub

Sub RequestData As Map
    Try
        Dim data As Map
        Dim ins As InputStream = Request.InputStream
        Dim tr As TextReader
        tr.Initialize(ins)
        Dim json As JSONParser
        json.Initialize(tr.ReadAll)
        data = json.NextObject
    Catch
        LogDebug("[Password/RequestData] " & LastException)
    End Try
    Return data
End Sub

Sub OpenConnection
    Try
        Dim config As Map = Utility.ReadConfig
        pool.Initialize(config.Get("DriverClass"), _
        config.Get("JdbcUrl"), _
        config.Get("User"), _
        config.Get("Password"))        
        
        Dim jo As JavaObject = pool
        Dim MaxPoolSize As Int = config.Get("MaxPoolSize")
        jo.RunMethod("setMaxPoolSize", Array(MaxPoolSize))
    Catch
        LogDebug(LastException)
    End Try
End Sub

Sub CloseConnection
    If pool.IsInitialized Then pool.ClosePool
End Sub

Sub WriteErrorLog(Module As String, Message As String)
    Dim con As SQL = pool.GetConnection
    Try
        Dim strSQL As String = $"INSERT INTO tbl_error (error_text) SELECT ?"$
        con.ExecNonQuery2(strSQL, Array As String("[" & Module & "]" & Message))
    Catch
        LogDebug("[WriteErrorLog] " & LastException)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub WriteUserLog(log_view As String, log_type As String, log_text As String, Log_User As String)
    Dim con As SQL = pool.GetConnection
    Try
        Dim strSQL As String = $"INSERT INTO tbl_users_log
        (log_view,
        log_type,
        log_text,
        log_user)
        SELECT ?, ?, ?, ?"$
        con.ExecNonQuery2(strSQL, Array As String(log_view, log_type, log_text, Log_User))
    Catch
        Dim msg_text As String = "[Exception] " & LastException
        WriteErrorLog("WriteUserLog", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub ChangePassword
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("password/change", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim user_email As String = Map1.Get("eml")
        Dim old_password As String = Map1.Get("old")
        Dim new_password As String = Map1.Get("new")
        
        If user_email = "" Or old_password = "" Or new_password = "" Then
            msg_text = "[Value Not Set]"
            WriteUserLog("password/change", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        
        If old_password = new_password Then
            msg_text = "[Same Password]"
            WriteUserLog("password/change", "fail", msg_text, 0)
            Utility.ReturnError("Error-Same-Value", Response)
            con.Close
            Return
        End If
        
        Dim strSQL As String
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        user_name,
        user_email,
        ifnull(user_location, '') AS user_location,
        ifnull(user_api_key, '') AS user_api_key,
        user_activation_flag
        FROM tbl_users
        WHERE user_email = ?
        AND user_hash = md5(concat(?, user_salt))"$

        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(user_email, old_password))
        If result.NextRow Then
            Dim salt As String = Utility.MD5(Rnd(100001, 999999))
            Dim hash As String = Utility.MD5(new_password & salt)
            Dim key As String = Utility.SHA1(hash)

            ' Update User Password
            strSQL = $"UPDATE tbl_users SET
            user_salt = ?,
            user_hash = ?,
            user_api_key = ?,
            user_token = NULL,
            modified_at = now()
            WHERE user_email = ?
            AND user_hash = MD5(concat(?, user_salt))"$
            con.ExecNonQuery2(strSQL, Array As String(salt, hash, key, user_email, old_password))

            WriteUserLog("password/change", "success", msg_text, result.GetInt("result"))
            Utility.ReturnSuccess("success", Response)
            
            ' Send email
            SendEmail(result.GetString("user_name"), result.GetString("user_email"), "change", "null", "null")
        Else
            msg_text = "[Not Found] " & user_email
            WriteUserLog("password/change", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Result", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("password/change", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub ResetPassword
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strSQL As String
    Try
        Dim Map1 As Map = RequestData
        If Map1 = Null Or Map1.IsInitialized = False Then
            msg_text = "[Null Value]"
            WriteUserLog("password/reset", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
        Dim user_email As String = Map1.Get("eml")
        
        If user_email = "" Then
            msg_text = "[Email Not Set]"
            WriteUserLog("password/reset", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Value", Response)
            con.Close
            Return
        End If
                
        strSQL = $"SELECT
        user_id AS `result`,
        'success' AS `message`,
        user_email,
        user_name
        FROM tbl_users
        WHERE user_email = ?"$
        Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(user_email))
        If result.NextRow Then
            Dim code As String = Utility.MD5(Rnd(100001, 999999))

            ' Update User activation code
            strSQL = $"UPDATE tbl_users SET
            user_activation_code = ?,
            modified_at = now()
            WHERE user_email = ?"$
            con.ExecNonQuery2(strSQL, Array As String(code, user_email))
            
            WriteUserLog("password/reset", "success", msg_text, result.GetInt("result"))
            Utility.ReturnSuccess("success", Response)
            
            ' Send email
            SendEmail(result.GetString("user_name"), result.GetString("user_email"), "reset", code, "null")        
        Else
            msg_text = "[Not Found] " & user_email
            WriteUserLog("password/reset", "fail", msg_text, 0)
            Utility.ReturnError("Error-No-Result", Response)
        End If
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("password/reset", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub ConfirmReset(code As String)
    Dim con As SQL = pool.GetConnection
    Dim msg_text As String
    Dim strMain As String
    Dim strSQL As String
    Try
        
        If code = "" Then
            strMain = $"<h1>Reset Password</h1>
            <p>Invalid reset code!</p>"$
            Utility.ReturnHTML(strMain, Response)
            con.Close
            Return
        Else            
            strSQL = $"SELECT
            user_name,
            user_email
            FROM tbl_users
            WHERE user_activation_code = ?"$
                        
            Dim result As ResultSet = con.ExecQuery2(strSQL, Array As String(code))
            If result.NextRow Then
                ' You may use other method To generate a more complex password with alphanumeric
                Dim salt As String = Utility.MD5(Rnd(100001, 999999))
                Dim temp As String = Utility.MD5(Rnd(100001, 999999))
                temp = temp.SubString(temp.Length - 8) ' get last 8 letters                
                Dim hash As String = Utility.MD5(temp & salt)
                Dim code As String = Utility.MD5(hash)
                
                strSQL = $"UPDATE tbl_users SET
                user_hash = ?,
                user_salt = ?,
                user_activation_code = ?,
                modified_at = now()
                WHERE user_email = ?"$
                con.ExecNonQuery2(strSQL, Array As String(hash, salt, code, result.GetString("user_email")))
                
                ' Send email
                SendEmail(result.GetString("user_name"), result.GetString("user_email"), "confirmreset", "null", temp)            
            Else
                msg_text = "[Not Found] "
                WriteUserLog("password/confirmreset", "fail", msg_text, 0)
                strMain = $"<h1>Reset Password</h1>
                <p>Invalid reset code!</p>"$
                Utility.ReturnHTML(strMain, Response)
                con.Close
                Return
            End If
        End If        
    Catch
        msg_text = "[Exception] " & LastException
        WriteErrorLog("password/confirmreset", msg_text)
        Utility.ReturnError("Error-Execute-Query", Response)
    End Try
    If con <> Null And con.IsInitialized Then con.Close
End Sub

Sub SendEmail(user_name As String, user_email As String, action As String, reset_code As String, temp_password As String)
    Dim smtp As SMTP
    Dim strMain As String
    Try
        Dim settings As Map = Utility.ReadSettings
        Dim APP_TRADEMARK As String = settings.Get("APP_TRADEMARK")
        Dim SMTP_USERNAME As String = settings.Get("SMTP_USERNAME")
        Dim SMTP_PASSWORD As String = settings.Get("SMTP_PASSWORD")
        Dim SMTP_SERVER As String = settings.Get("SMTP_SERVER")
        Dim SMTP_USESSL As String = settings.Get("SMTP_USESSL")
        Dim SMTP_PORT As Int = settings.Get("SMTP_PORT")
        'Dim HTML_BODY As String = settings.Get("HTML_BODY")
        Dim EmailSubject As String
        Dim EmailBody As String
        
        Select Case action
            Case "change"
                EmailSubject = "Your password has been changed"
                EmailBody = $"Hi ${user_name},<br />
                We have noticed that you have changed your password recently.<br />
                <br />
                If this action is not initiated by you, please contact us immediately.<br />
                Otherwise, please ignore this email.<br />
                <br />
                Regards,<br />
                <em>${APP_TRADEMARK}</em>"$                            
            Case "reset"
                EmailSubject = "Request to reset your password"
                EmailBody = $"Hi ${user_name},<br />
                We have received a request from you to reset your password.<br />
                <br />
                If this action is not initiated by you, please contact us immediately.<br />
                Otherwise, click the following link to confirm:<br />
                <br />
                <a href="${Main.ROOT_URL}/password/confirmreset/${reset_code}" id="reset-link" title="reset" target="_blank">${Main.ROOT_URL}/password/confirmreset/${reset_code}</a><br />
                <br />
                If the link is not working, please copy the url to your browser.<br />
                If you have changed your mind, just ignore this email.<br />                
                <br />
                Regards,<br />
                <em>${APP_TRADEMARK}</em>"$
            Case "confirmreset"
                EmailSubject = "Your password has been reset"
                EmailBody = $"Hi ${user_name},<br />
                Your password has been reset.<br />
                Please use the following temporary password to log in.<br />
                Password: ${temp_password}<br />
                <br />
                Once you are able to log in, please change to a new password.<br />
                <br />
                Regards,<br />
                <em>${APP_TRADEMARK}</em>"$
                
                strMain = $"<h1>Confirm Reset Password</h1>
                <p>Password reset successfully.<br/>Please check your email for temporary password.</p>"$
                Utility.ReturnHTML(strMain, Response)
            Case Else
                strMain = $"<h1>Send Email</h1>
                <p>Unrecognized action!</p>"$
                Utility.ReturnHTML(strMain, Response)
                Return
        End Select
        
        smtp.Initialize(SMTP_SERVER, SMTP_PORT, SMTP_USERNAME, SMTP_PASSWORD, "SMTP")
        If SMTP_USESSL.ToUpperCase = "TRUE" Then smtp.UseSSL = True Else smtp.UseSSL = False            
        smtp.Sender = SMTP_USERNAME
        smtp.To.Add(user_email)
        smtp.AuthMethod = smtp.AUTH_LOGIN
        'If HTML_BODY.ToUpperCase = "TRUE" Then smtp.HtmlBody = True Else smtp.HtmlBody = False
        smtp.HtmlBody = True
        smtp.Subject = EmailSubject
        smtp.Body = EmailBody
        LogDebug(smtp.body)
        LogDebug("Sending email...")
        'Dim sm As Object = smtp.Send
        Wait For (smtp.Send) SMTP_MessageSent (Success As Boolean)
        If Success Then
            LogDebug("Message sent successfully")
        Else
            LogDebug("Error sending message")
            LogDebug(LastException)
        End If
    Catch
        LogDebug(LastException)
        Utility.ReturnError("Error-Send-Email", Response)
    End Try
End Sub

aeric · Jan 1, 2021

TestHandler (TestHandler.bas):

'Handler class
Sub Class_Globals
    Dim Request As ServletRequest
    Dim Response As ServletResponse
    Dim pool As ConnectionPool
End Sub

Public Sub Initialize
    
End Sub

Sub Handle(req As ServletRequest, resp As ServletResponse)
    Request = req
    Response = resp
    Select Request.RequestURI
        Case "/test/sendemail"           
            EmailTest
        Case "/test/connectdb"
            ConnectionTest
        Case "/test/readsettings"
            Dim settings As Map = Utility.ReadSettings
            LogDebug(settings.Get("SMTP_SERVER"))
            Response.Write("SMTP_SERVER: " & settings.Get("SMTP_SERVER"))
        Case Else
            Utility.ReturnSuccess("success", Response)
    End Select
End Sub

Sub ConnectionTest
    Try
        Dim config As Map = Utility.ReadConfig
        pool.Initialize(config.Get("DriverClass"), _
        config.Get("JdbcUrl"), _
        config.Get("User"), _
        config.Get("Password"))       
        
        ' change pool size...
        ' Credit to Harris
        ' https://www.b4x.com/android/forum/threads/poolconnection-problem-connection-has-timed-out.95067/post-600974
        Dim jo As JavaObject = pool
        Dim MaxPoolSize As Int = config.Get("MaxPoolSize")
        jo.RunMethod("setMaxPoolSize", Array(MaxPoolSize))
        Dim con As SQL = pool.GetConnection
        If con <> Null And con.IsInitialized Then con.Close
        Response.Write("Connection successful.")
    Catch
        ' If connection timeout, check database username and password are correct?
        LogDebug(LastException)
        Response.Write("Error fetching connection.")
    End Try
    If pool.IsInitialized Then pool.ClosePool
End Sub

' Send a test email to Admin Email
Sub EmailTest
    Try
        Dim SMTP As SMTP       
        Dim settings As Map = Utility.ReadSettings
        Dim SMTP_USERNAME As String = settings.Get("SMTP_USERNAME")
        Dim SMTP_PASSWORD As String = settings.Get("SMTP_PASSWORD")
        Dim SMTP_SERVER As String = settings.Get("SMTP_SERVER")
        Dim SMTP_PORT As Int = settings.Get("SMTP_PORT")
        Dim SMTP_USESSL As String = settings.Get("SMTP_USESSL")
        Dim ADMIN_EMAIL As String = settings.Get("ADMIN_EMAIL")
        SMTP.Initialize(SMTP_SERVER, SMTP_PORT, SMTP_USERNAME, SMTP_PASSWORD, "SMTP")
        If SMTP_USESSL.ToUpperCase = "TRUE" Then SMTP.UseSSL = True Else SMTP.UseSSL = False           
        'SMTP.StartTLSMode = True
        If ADMIN_EMAIL = "" Then
            LogDebug("SendEmail has been disabled!")
            Response.Write("Email test has been disabled!")
        End If
        LogDebug("Sending email...")
        SMTP.Sender = SMTP_USERNAME
        SMTP.To.Add(ADMIN_EMAIL)
        SMTP.AuthMethod = SMTP.AUTH_LOGIN
        SMTP.HtmlBody = True
        SMTP.subject = "Message from B4J mail"
        SMTP.body = $"<strong>EMAIL TEST SUCCESS</strong>
        <hr>
        Email is sent from ${Main.ROOT_URL}<br/>
        The current time here is: ${DateTime.Time(DateTime.Now)}"$
        Wait For (SMTP.Send) SMTP_MessageSent (Success As Boolean)
        If Success Then
            LogDebug("Message sent successfully")
            Response.Write("Message sent successfully")
        Else
            ' If failed, check values in settings.ini
            LogDebug("Error sending message")
            Response.Write("Error sending message")
        End If
    Catch
        LogDebug(LastException)
        Response.Write(LastException)
    End Try
End Sub

Utility (Utility.bas):

' Utility Code module
Sub Process_Globals
    
End Sub

Sub BuildHtml(strHTML As String, Settings As Map) As String
    ' Replace variables with $KEY$ with new content from Map
    strHTML = WebUtils.ReplaceMap(strHTML, Settings)
    Return strHTML
End Sub

Sub BuildView(strHTML As String, View As String) As String
    ' Replace @VIEW@ tag with new content
    strHTML = strHTML.Replace("@VIEW@", View)
    Return strHTML
End Sub

Sub ReadConfig As Map
    Return File.ReadMap(File.DirAssets, "config.properties")
End Sub

Sub ReadSettings As Map
    Return File.ReadMap(File.DirApp, "settings.ini")
End Sub

Sub ReadTextFile(FileName As String) As String
    Return File.ReadString(File.DirAssets, FileName)
End Sub

Sub MD5(str As String) As String
    Dim data(0) As Byte
    Dim MD As MessageDigest
    Dim Bconv As ByteConverter

    data = Bconv.StringToBytes(str, "UTF8")
    data = MD.GetMessageDigest(data, "MD5")
    Return Bconv.HexFromBytes(data).ToLowerCase
End Sub

Sub SHA1(str As String) As String
    Dim data(0) As Byte
    Dim MD As MessageDigest
    Dim Bconv As ByteConverter

    data = Bconv.StringToBytes(str, "UTF8")
    data = MD.GetMessageDigest(data, "SHA-1")
    Return Bconv.HexFromBytes(data).ToLowerCase
End Sub

Sub List2Json(L As List) As String
    Dim gen As JSONGenerator
    gen.Initialize2(L)
    Return gen.ToString
End Sub

Sub Map2Json(M As Map) As String
    Dim L As List
    L.Initialize
    L.Add(M)
    Dim gen As JSONGenerator
    gen.Initialize2(L)
    Return gen.ToString
End Sub

Sub ReturnError(Message As String, resp As ServletResponse)
    If Message = "" Then Message = "failed"
    Dim Map1 As Map = CreateMap("result": -1, "message": Message)   
    resp.ContentType = "application/json"
    resp.Write(Map2Json(Map1))
End Sub

Sub ReturnSuccess(Message As String, resp As ServletResponse)
    If Message = "" Then Message = "success"
    Dim Map1 As Map = CreateMap("result": 0, "message": Message)
    resp.ContentType = "application/json"
    resp.Write(Map2Json(Map1))
End Sub

Sub ReturnConnect(resp As ServletResponse)
    Dim Map1 As Map = CreateMap("Connected": 1)
    resp.ContentType = "application/json"
    resp.Write(Map2Json(Map1))
End Sub

Sub ReturnHTML(str As String, resp As ServletResponse)
    resp.ContentType = "text/html"
    resp.Write(str)
End Sub

Sub ReturnJSON(map As Map, resp As ServletResponse)
    resp.ContentType = "application/json"
    resp.Write(Map2Json(map))
End Sub

Sub ReturnJSON2(list As List, resp As ServletResponse)
    resp.ContentType = "application/json"
    resp.Write(List2Json(list))
End Sub

WebUtils (WebUtils.bas):

'version 1.00
Sub Process_Globals
    Public bc As ByteConverter
End Sub

Public Sub init
    bc.LittleEndian = True
End Sub

#Region Test

Public Sub EscapeHtml(Raw As String) As String
    Dim sb As StringBuilder
    sb.Initialize
    For i = 0 To Raw.Length - 1
        Dim C As Char = Raw.CharAt(i)
        Select C
            Case QUOTE
                sb.Append("&quot;")
            Case "'"
                sb.Append("&#39;")
            Case "<"
                sb.Append("&lt;")
            Case ">"
                sb.Append("&gt;")
            Case "&"
                sb.Append("&amp;")
            Case Else
                sb.Append(C)
        End Select
    Next
    Return sb.ToString
End Sub

Public Sub ReplaceMap(Base As String, Replacements As Map) As String
    Dim pattern As StringBuilder
    pattern.Initialize
    For Each k As String In Replacements.Keys
        If pattern.Length > 0 Then pattern.Append("|")
        pattern.Append("\$").Append(k).Append("\$")
    Next
    Dim m As Matcher = Regex.Matcher(pattern.ToString, Base)
    Dim result As StringBuilder
    result.Initialize
    Dim lastIndex As Int
    Do While m.Find
        result.Append(Base.SubString2(lastIndex, m.GetStart(0)))
        Dim replace As String = Replacements.Get(m.Match.SubString2(1, m.Match.Length - 1))
        If m.Match.ToLowerCase.StartsWith("$h_") Then replace = EscapeHtml(replace)
        result.Append(replace)
        lastIndex = m.GetEnd(0)
    Loop
    If lastIndex < Base.Length Then result.Append(Base.SubString(lastIndex))
    Return result.ToString
End Sub

Public Sub RedirectTo(ws As WebSocket, TargetUrl As String)
    ws.Eval("window.location = arguments[0]", Array As Object(TargetUrl))
End Sub

Public Sub ReadString(In As InputStream) As String
    Dim len As Int = bc.IntsFromBytes(ReadBytesFromStream(In, 4))(0)
    Return BytesToString(ReadBytesFromStream(In, len), 0, len, "UTF8")
End Sub

#End Region

Sub ReadBytesFromStream(In As InputStream, Length As Int) As Byte()
    If Length > 5000 Then
        Log("Error reading from stream")
        Return Null
    End If
    Dim b(Length) As Byte
    Dim count As Int = 0
    Do While count < Length
        Dim read As Int = In.ReadBytes(b, count, Length - count)
        If read <= 0 Then
            Log("Error reading from stream.")
            Return Null
        End If
        count = count + read
    Loop
    Return b
End Sub

aeric · Jan 1, 2021

Please edit the User and Password for MySQL database login. You may also need to change the ROOT_URL. The jar file need to be recompile for any changes.

config (config.properties):

#Lines starting with '#' are comments.
#Backslash character at the end of line means that the command continues in the next line.

#DATABASE CONFIGURATION

#MS SQL Server:
#DriverClass=net.sourceforge.jtds.jdbc.Driver
#JdbcUrl=jdbc:jtds:sqlserver://localhost/computer_api

#PostgreSQL:
#JdbcUrl=jdbc:postgresql://localhost/computer_api
#DriverClass=org.postgresql.Driver

# MySQL Server:
DriverClass=com.mysql.jdbc.Driver
JdbcUrl=jdbc:mysql://localhost/computer_api?characterEncoding=utf8
User=aeric
Password=1LoveB4X
MaxPoolSize=100

# Server Path
ROOT_PATH=/
ROOT_URL=http://127.0.0.1
#ROOT_URL=https://api.puterise.com

#Java server port
ServerPort=17178
SSLPort=17179

You can change the values in settings.ini and the values will be updated once the page is refreshed. No need to recompile the jar file.

settings (settings.ini):

# API Server
# JAR: jAPI.jar

# App Constant
APP_TITLE=API Server
APP_TRADEMARK=COMPANYNAME
APP_COPYRIGHT=Copyright My Company Name 2021
HOME_TITLE=API SERVER

# Define Email Settings
SMTP_USERNAME=yourname@yourdomain.com
SMTP_PASSWORD=xxxxxxxxxxxxxxx
SMTP_SERVER=mail.yourdomain.com
SMTP_PORT=465
SMTP_USESSL=True
HTML_BODY=True
ADMIN_EMAIL=yourname@yourdomain.com

aeric · Jan 1, 2021

Execute the following command to create the database.

computer_api.sql:

SET NAMES utf8;
SET time_zone = '+00:00';
SET foreign_key_checks = 0;
SET sql_mode = 'NO_AUTO_VALUE_ON_ZERO';

CREATE DATABASE computer_api CHARACTER SET utf8 COLLATE utf8_unicode_ci;

USE computer_api;

DROP TABLE IF EXISTS `tbl_error`;
CREATE TABLE `tbl_error` (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `error_text` varchar(1000) COLLATE utf8_unicode_ci DEFAULT NULL,
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;


DROP TABLE IF EXISTS `tbl_users`;
CREATE TABLE `tbl_users` (
  `user_id` int(11) NOT NULL AUTO_INCREMENT,
  `user_email` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_hash` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_salt` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_name` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_location` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_image_file` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_token` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_api_key` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activation_code` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activation_flag` varchar(1) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activated_at` datetime DEFAULT NULL,
  `user_last_login_at` datetime DEFAULT NULL,
  `user_login_count` int(11) DEFAULT '0',
  `user_active` int(11) DEFAULT '0',
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  `modified_at` datetime DEFAULT NULL,
  PRIMARY KEY (`user_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;


DROP TABLE IF EXISTS `tbl_users_log`;
CREATE TABLE `tbl_users_log` (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `log_view` varchar(30) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_type` varchar(30) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_text` varchar(1000) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_user` int(11) DEFAULT NULL,
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

To enable delete user token schedule, run the following command:

Delete user token every hour:

USE computer_api;

CREATE EVENT clear_user_token_every_hour
ON SCHEDULE EVERY 1 HOUR
STARTS CURRENT_TIMESTAMP
ENDS CURRENT_TIMESTAMP + INTERVAL 12 MONTH
ON COMPLETION PRESERVE
DO
   Update tbl_users SET user_token = Null
   WHERE user_last_login_at < NOW() - INTERVAL 1 HOUR;

SHOW PROCESSLIST;
SET GLOBAL event_scheduler = ON;
SHOW EVENTS FROM computer_api;

Edit: You may want to consider using utf8mb4 for the database collation. See post #35.

aeric · Jan 2, 2021

User/GetProfile added
B4J API code reuploaded in post #1.
B4A client code uploaded in post #1.

aeric · Jan 3, 2021

Fix bugs when changing password (not return success).

Set user_token = NULL when updating password. Client need to logout and login again after changing password to refresh API Key and Token.

B4X:

strSQL = $"UPDATE tbl_users SET
user_salt = ?,
user_hash = ?,
user_api_key = ?,
user_token = NULL,
modified_at = now()
WHERE user_email = ?
AND user_hash = MD5(concat(?, user_salt))"$
con.ExecNonQuery2(strSQL, Array As String(salt, hash, key, user_email, old_password))

Updated jAPI.zip and B4A.zip in post #1.

cklester · Jan 3, 2021

Hi, @aeric . I've downloaded the jAPI file, but it is missing some modules.

Is it supposed to have all the modules, or do I create those myself?

aeric · Jan 4, 2021

cklester said:
Hi, @aeric . I've downloaded the jAPI file, but it is missing some modules.

View attachment 105381

Is it supposed to have all the modules, or do I create those myself?

I downloaded the file. All the modules are inside the file. Are you sure you unzip to a folder?

cklester · Jan 4, 2021

aeric said:
I downloaded the file. All the modules are inside the file. Are you sure you unzip to a folder?

? ? ?

Wow! Yes, I had opened it straight from the ZIP file. Oops!

That's the first time I've ever done that. I guess I was in such an excited rush to see the app in action that I just skipped one little step. ha!

Thank you!

cklester · Jan 4, 2021

@aeric Are you planning on creating a sample B4J client app as well? Just curious if I should wait or roll my own.

aeric · Jan 4, 2021

cklester said:
@aeric Are you planning on creating a sample B4J client app as well? Just curious if I should wait or roll my own.

You may do it if you want. If I have time, I would create a B4XPages client. Actually, I have another project name B4XQuiz. I would based on that project to make the client for this sample.

cklester · Jan 4, 2021

In order to develop a B4J client, I'm trying to run your API server in Release mode. However, I'm getting the following when I try that:

(This works fine with Debug compilation.)

B4X:

...
2021-01-04 16:38:33.909:INFO:oejs.AbstractConnector:main: Started ServerConnector@489115ef{HTTP/1.1,[http/1.1]}{0.0.0.0:17178}
main._appstart (java line: 105)
java.lang.IllegalStateException: no valid keystore
    at org.eclipse.jetty.util.security.CertificateUtils.getKeyStore(CertificateUtils.java:50)
    at org.eclipse.jetty.util.ssl.SslContextFactory.loadKeyStore(SslContextFactory.java:1071)
    at org.eclipse.jetty.util.ssl.SslContextFactory.load(SslContextFactory.java:262)
    at org.eclipse.jetty.util.ssl.SslContextFactory.doStart(SslContextFactory.java:229)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.SslConnectionFactory.doStart(SslConnectionFactory.java:72)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.AbstractConnector.doStart(AbstractConnector.java:279)
    at org.eclipse.jetty.server.AbstractNetworkConnector.doStart(AbstractNetworkConnector.java:81)
    at org.eclipse.jetty.server.ServerConnector.doStart(ServerConnector.java:244)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.server.Server.doStart(Server.java:398)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at anywheresoftware.b4j.object.ServerWrapper.Start(ServerWrapper.java:220)
    at my.b4j.api.main._appstart(main.java:105)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke0(Native Method)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke(NativeMethodAccessorImpl.java:62)
    at java.base/jdk.internal.reflect.DelegatingMethodAccessorImpl.invoke(DelegatingMethodAccessorImpl.java:43)
    at java.base/java.lang.reflect.Method.invoke(Method.java:566)
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:91)
    at anywheresoftware.b4a.BA.raiseEvent(BA.java:78)
    at my.b4j.api.main.main(main.java:28)
main.main (java line: 28)
java.lang.RuntimeException: java.lang.IllegalStateException: no valid keystore
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:120)
    at anywheresoftware.b4a.BA.raiseEvent(BA.java:78)
    at my.b4j.api.main.main(main.java:28)
Caused by: java.lang.IllegalStateException: no valid keystore
    at org.eclipse.jetty.util.security.CertificateUtils.getKeyStore(CertificateUtils.java:50)
    at org.eclipse.jetty.util.ssl.SslContextFactory.loadKeyStore(SslContextFactory.java:1071)
    at org.eclipse.jetty.util.ssl.SslContextFactory.load(SslContextFactory.java:262)
    at org.eclipse.jetty.util.ssl.SslContextFactory.doStart(SslContextFactory.java:229)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.SslConnectionFactory.doStart(SslConnectionFactory.java:72)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.AbstractConnector.doStart(AbstractConnector.java:279)
    at org.eclipse.jetty.server.AbstractNetworkConnector.doStart(AbstractNetworkConnector.java:81)
    at org.eclipse.jetty.server.ServerConnector.doStart(ServerConnector.java:244)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.server.Server.doStart(Server.java:398)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at anywheresoftware.b4j.object.ServerWrapper.Start(ServerWrapper.java:220)
    at my.b4j.api.main._appstart(main.java:105)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke0(Native Method)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke(NativeMethodAccessorImpl.java:62)
    at java.base/jdk.internal.reflect.DelegatingMethodAccessorImpl.invoke(DelegatingMethodAccessorImpl.java:43)
    at java.base/java.lang.reflect.Method.invoke(Method.java:566)
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:91)
    ... 2 more

Any idea what I need to do to allow this to run in Release?

leandro.legnaro · Jan 5, 2021

aeric said:

Execute the following command to create the database.

computer_api.sql:

SET NAMES utf8;
SET time_zone = '+00:00';
SET foreign_key_checks = 0;
SET sql_mode = 'NO_AUTO_VALUE_ON_ZERO';

CREATE DATABASE computer_api CHARACTER SET utf8 COLLATE utf8_unicode_ci;

USE computer_api;

DROP TABLE IF EXISTS `tbl_error`;
CREATE TABLE `tbl_error` (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `error_text` varchar(1000) COLLATE utf8_unicode_ci DEFAULT NULL,
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;


DROP TABLE IF EXISTS `tbl_users`;
CREATE TABLE `tbl_users` (
  `user_id` int(11) NOT NULL AUTO_INCREMENT,
  `user_email` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_hash` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_salt` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_name` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_location` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_image_file` varchar(255) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_token` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_api_key` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activation_code` varchar(40) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activation_flag` varchar(1) COLLATE utf8_unicode_ci DEFAULT NULL,
  `user_activated_at` datetime DEFAULT NULL,
  `user_last_login_at` datetime DEFAULT NULL,
  `user_login_count` int(11) DEFAULT '0',
  `user_active` int(11) DEFAULT '0',
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  `modified_at` datetime DEFAULT NULL,
  PRIMARY KEY (`user_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;


DROP TABLE IF EXISTS `tbl_users_log`;
CREATE TABLE `tbl_users_log` (
  `id` int(11) NOT NULL AUTO_INCREMENT,
  `log_view` varchar(30) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_type` varchar(30) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_text` varchar(1000) COLLATE utf8_unicode_ci DEFAULT NULL,
  `log_user` int(11) DEFAULT NULL,
  `created_at` timestamp NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;

To enable delete user token schedule, run the following command:

Delete user token every hour:

USE computer_api;

CREATE EVENT clear_user_token_every_hour
ON SCHEDULE EVERY 1 HOUR
STARTS CURRENT_TIMESTAMP
ENDS CURRENT_TIMESTAMP + INTERVAL 12 MONTH
ON COMPLETION PRESERVE
DO
   Update tbl_users SET user_token = Null
   WHERE user_last_login_at < NOW() - INTERVAL 1 HOUR;

SHOW PROCESSLIST;
SET GLOBAL event_scheduler = ON;
SHOW EVENTS FROM computer_api;

Very good job! Congrats

aeric · Jan 5, 2021

cklester said:

In order to develop a B4J client, I'm trying to run your API server in Release mode. However, I'm getting the following when I try that:

(This works fine with Debug compilation.)

B4X:

...
2021-01-04 16:38:33.909:INFO:oejs.AbstractConnector:main: Started ServerConnector@489115ef{HTTP/1.1,[http/1.1]}{0.0.0.0:17178}
main._appstart (java line: 105)
java.lang.IllegalStateException: no valid keystore
    at org.eclipse.jetty.util.security.CertificateUtils.getKeyStore(CertificateUtils.java:50)
    at org.eclipse.jetty.util.ssl.SslContextFactory.loadKeyStore(SslContextFactory.java:1071)
    at org.eclipse.jetty.util.ssl.SslContextFactory.load(SslContextFactory.java:262)
    at org.eclipse.jetty.util.ssl.SslContextFactory.doStart(SslContextFactory.java:229)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.SslConnectionFactory.doStart(SslConnectionFactory.java:72)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.AbstractConnector.doStart(AbstractConnector.java:279)
    at org.eclipse.jetty.server.AbstractNetworkConnector.doStart(AbstractNetworkConnector.java:81)
    at org.eclipse.jetty.server.ServerConnector.doStart(ServerConnector.java:244)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.server.Server.doStart(Server.java:398)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at anywheresoftware.b4j.object.ServerWrapper.Start(ServerWrapper.java:220)
    at my.b4j.api.main._appstart(main.java:105)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke0(Native Method)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke(NativeMethodAccessorImpl.java:62)
    at java.base/jdk.internal.reflect.DelegatingMethodAccessorImpl.invoke(DelegatingMethodAccessorImpl.java:43)
    at java.base/java.lang.reflect.Method.invoke(Method.java:566)
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:91)
    at anywheresoftware.b4a.BA.raiseEvent(BA.java:78)
    at my.b4j.api.main.main(main.java:28)
main.main (java line: 28)
java.lang.RuntimeException: java.lang.IllegalStateException: no valid keystore
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:120)
    at anywheresoftware.b4a.BA.raiseEvent(BA.java:78)
    at my.b4j.api.main.main(main.java:28)
Caused by: java.lang.IllegalStateException: no valid keystore
    at org.eclipse.jetty.util.security.CertificateUtils.getKeyStore(CertificateUtils.java:50)
    at org.eclipse.jetty.util.ssl.SslContextFactory.loadKeyStore(SslContextFactory.java:1071)
    at org.eclipse.jetty.util.ssl.SslContextFactory.load(SslContextFactory.java:262)
    at org.eclipse.jetty.util.ssl.SslContextFactory.doStart(SslContextFactory.java:229)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.SslConnectionFactory.doStart(SslConnectionFactory.java:72)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.start(ContainerLifeCycle.java:138)
    at org.eclipse.jetty.util.component.ContainerLifeCycle.doStart(ContainerLifeCycle.java:117)
    at org.eclipse.jetty.server.AbstractConnector.doStart(AbstractConnector.java:279)
    at org.eclipse.jetty.server.AbstractNetworkConnector.doStart(AbstractNetworkConnector.java:81)
    at org.eclipse.jetty.server.ServerConnector.doStart(ServerConnector.java:244)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at org.eclipse.jetty.server.Server.doStart(Server.java:398)
    at org.eclipse.jetty.util.component.AbstractLifeCycle.start(AbstractLifeCycle.java:68)
    at anywheresoftware.b4j.object.ServerWrapper.Start(ServerWrapper.java:220)
    at my.b4j.api.main._appstart(main.java:105)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke0(Native Method)
    at java.base/jdk.internal.reflect.NativeMethodAccessorImpl.invoke(NativeMethodAccessorImpl.java:62)
    at java.base/jdk.internal.reflect.DelegatingMethodAccessorImpl.invoke(DelegatingMethodAccessorImpl.java:43)
    at java.base/java.lang.reflect.Method.invoke(Method.java:566)
    at anywheresoftware.b4a.BA.raiseEvent2(BA.java:91)
    ... 2 more

Any idea what I need to do to allow this to run in Release?

Just delete these lines and ConfigureSSL sub.

B4X:

#If RELEASE
    ConfigureSSL(SSL_PORT)
    ROOT_URL = config.Get("ROOT_URL") & ":" & SSL_PORT
#End If

You also don't need HttpsFilter.bas file. These code is for enabling SSL in hosting server.

In B4A project, open Manifest Editor and uncomment this line to allow the app to communicate with http protocol.

B4X:

CreateResourceFromFile(Macro, Core.NetworkClearText)

aeric · Jan 12, 2021

B4J client attached in post #1. There are some conflict with the B4J pane click event and CustomListView ItemClick. The ShowPage also not working as it should be. I will find a workaround. However the connection with server has no issue.

Mashiane · Jan 13, 2021

Awesome, I appreciate your work. Im just starting my jServer and jNetwork learning and this has helped a great deal. Such a clean and nice implementation.

Perfect!!! Congrats @aeric

cklester · Jan 13, 2021

Can you add file uploading? ?

I need to be able to send up a file with a corresponding session ID from an app, not from a web site.

aeric · Jan 13, 2021

Mashiane said:
Awesome, I appreciate your work. Im just starting my jServer and jNetwork learning and this has helped a great deal. Such a clean and nice implementation.

Perfect!!! Congrats @aeric

Thanks Mashiane for so much Likes ??

aeric · Jan 13, 2021

cklester said:
Can you add file uploading? ?

I need to be able to send up a file with a corresponding session ID from an app, not from a web site.

Sorry I am not sure about session. When we use API, we are not using session. We are sending a token as authentication.

Share My Creation [B4J] [MySQL] [API] Server (Key + Token) and [B4X] User Login Apps

Attachments

aeric

Expert

aeric

Expert

aeric

Expert

aeric

Expert

aeric

Expert

aeric

Expert

cklester

Well-Known Member

aeric

Expert

cklester

Well-Known Member

cklester

Well-Known Member

aeric

Expert

cklester

Well-Known Member

leandro.legnaro

Member

aeric

Expert

aeric

Expert

Mashiane

Expert

cklester

Well-Known Member

aeric

Expert

aeric

Expert