/* LoginP Server - DMS - june 98 - by Sylvain HUET */ /* LoginP3 Server - DMS - nov 98 - by Patrice FAVRE */ /* Rev. June 00 - by Sebastien DENEUX */ /* LoginP4 Server - DMS - February 2003 - by Bob Le Gob */ /*tailles min/max des différents champs*/ var loginMinSize = 3;; var loginMaxSize = 20;; var notAllowedChars = "<>";; /*carac non autorisé dans le login peu importe la position*/ var notAllowedChars2 = "0123456789!\"#$%&'()*+,-./:; = ?[\]^_`{|}~";; /*carac non autorisé en première position du login*/ var min_password_length = 4;; var max_password_length = 20;; defcom CloginRefused = loginRefused I I;; defcom CloginOk = loginOk S I;; defcom CloginNum = loginNum S;; defcom CresultForgotPassword = resultForgotPassword I;; /*result msg when user clicks on forgot password button*/ defcom CresultAskChangePassword = resultAskChangePassword S I I;; /*result numbers to crypt pass when user click on change password button*/ defcom CresultChangePassword = resultChangePassword I;; /*result msg when user click on change password button*/ defcom CresultBecomeMember = resultBecomeMember I;; /*result msg when user click on become member button*/ defcom CShowAdminInterface = ShowAdminInterface S;; /*show the admin interface on the client*/ defcom CupdateResult = updateResult I;; /*result when update a password/email in the db*/ defcom CresultFetch = resultFetch I S I S;; /*status/email/maxlog/adminLevel*/ typeof open = I;; /*when 1, allow unregistered logins*/ typeof cookie = S;; /*when 1, enable cookie on client*/ typeof changePassword = I;; /*when 1, button modify password on client*/ typeof forgotPassword = I;; /*when 1, button forgot password on client*/ typeof becomeMember = I;; /*when 1, button become member on client*/ typeof loginContentsCheck = I;; /*login contains connection login or another column (must be unique)*/ typeof loginContentsColumnName = S;; typeof emailSenderForgotPwd = S;; /*to send email when user click on button forgot password*/ typeof maxAccountPerEmail = I;; /*maximum account per user when become member*/ typeof initFieldsSetRequest = S;; /*init fields SET request when become member*/ typeof dbname = S;; typeof dblogin = S;; typeof dbpassw = S;; typeof LTable = S;; typeof LColName = S;; typeof LColPasswd = S;; typeof LColEmail = S;; /*email*/ typeof LColNumber = S;; /*nb passwords left before expiration*/ typeof LColAdminLevel = S;; /*condition client = = admin*/ typeof adminLevelItemReference = S;; /*condition client = = moderator*/ typeof LColNbLogOK = S;; /*nb log successful since first connection*/ typeof LColNbLogPasOK = S;; /*nb log unsuccessful since last successfull connection*/ typeof LColDateDerniereConnexion = S;; /*last connection date*/ typeof LColConditionValidite = S;; typeof maxlog = I;; /*max successful logs since last password change*/ typeof maxlogKO = I;; /*nb unsuccessful logs since last successful connection*/ typeof wrnlog = I;; /*% log left before expiration password warning*/ typeof BackgroundFileName = S;; /*background filename*/ typeof db = SqlDB;; typeof lAdmins = [CLIENT r1];; /*administrators list*/ typeof lClisConnected = [S r1];; /*we keep a list of the connected users that are not on the db in accept unregistered passwords*/ typeof lNotAllowedSubStrings = [S r1];; /*substrings not allowed in login names*/ typeof lNotAllowedStrings = [S r1];; /*strings not allowed in login names*/ var reloadnotAllowedLoginsFilePeriod = 1200;; /*file reload period in seconds*/ typeof lAdminLevel = [[S S] r1];; /* [Admin_level login_extension] list */ var iSizLAdmLvl = 0;; /* List size */ /*-------------------*/ fun cbCliByCli(a, b) = a == b;; /*-------------------*/ fun cbCliByLogin(a, b) = !strcmp a b;; /*------------*/ /*check in the db if the login exists*/ /*returns nil if login does not exists*/ fun ExistLogin(login) = hd hd SqlRequest db strcatn "SELECT "::LColName::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil;; /*------------*/ /*returns the number of accounts in the database*/ fun GetNbRecords() = let hd hd SqlRequest db strcatn "SELECT COUNT(*) FROM "::LTable::nil nil -> nb in if (nb == nil) then "0" else nb;; /*------------*/ /*returns the number of accounts reserved by the user*/ fun GetNbUserAccount(email) = let hd hd SqlRequest db strcatn "SELECT COUNT("::LColEmail::") FROM "::LTable::" WHERE "::LColEmail::"=?"::nil (SQL_CHAR email)::nil -> nb in if (nb == nil) then 0 else atoi nb;; /*------------*/ fun cbCliDestroyed(cli) = set lAdmins = remove_from_list lAdmins cli; if (open && ((ExistLogin _DMSgetLogin cli) == nil)) then set lClisConnected = removef_from_list lClisConnected @cbCliByLogin (_DMSgetLogin cli) else nil; _DMSevent this cli "destroyed" nil nil;; /*------------*/ /*returns number uses for encyption*/ fun InitL(login) = let hd hd SqlRequest db strcatn "SELECT "::LColNumber::" FROM "::LTable:: " WHERE "::LTable::"."::LColName::"=?"::nil (SQL_CHAR login)::nil -> num in if ((atoi num) == 0) then nil else num;; /*-----------*/ /*retourne 1 si les carac ascii de s st tous autorisés*/ fun CheckAsciiAuthorise(l, pos, size, prec)= if (l == nil) then 1 else let l -> [t q] in if (pos==0 && (strfind ctoa t notAllowedChars2 0)!=nil) || (t<32) || (t==32 && pos==0) || (t==32 && pos==size) || (t==32 && prec==32) || (strfind ctoa t notAllowedChars 0)!=nil then 0 else CheckAsciiAuthorise q pos+1 size t;; /*-----------*/ /*retourne 1 si le login a une syntaxe valide*/ fun IsLoginSyntaxValid(login) = let strlen login -> llogin in if (((llogin < loginMinSize) || (llogin > loginMaxSize)) /*size*/ || (CheckAsciiAuthorise strtolist login 0 llogin nil) !=1 ) then 0 else 1;; /*------------*/ /*returns the value of the column from the database*/ fun GetValueColumnLoginContents(login) = hd hd SqlRequest db strcatn "SELECT "::loginContentsColumnName::" FROM "::LTable::" WHERE ":: LColName::"=?"::nil (SQL_CHAR login)::nil;; /*------------*/ fun IsAllowedSubString(name, l) = if (l == nil) then 1 else if (strfindi hd l name 0)!=nil then 0 else IsAllowedSubString name tl l;; /*------------*/ fun IsAllowedString(name, l) = if (l == nil) then 1 else if !strcmpi hd l name then 0 else IsAllowedString name tl l;; /*------------*/ /*returns 1 if name allowed else 0*/ fun IsAllowed(name) = (IsAllowedString name lNotAllowedStrings) && (IsAllowedSubString name lNotAllowedSubStrings);; fun BLG_GetLoginExtensionS(l, str) = let hd l -> [lvl ext] in if !strcmp lvl str then ext else BLG_GetLoginExtensionS tl l str;; fun BLG_GetLoginExtensionI(n) = let nth_list lAdminLevel n -> [_ ext] in ext;; fun BLG_CheckLoginExistence(cliname) = let _DMSbyLoginI cliname -> ret in if (ret != nil) then ret else ( set ret = _DMSbyLoginI (strcat cliname "[away]"); if (ret != nil) then ret else let 0 -> i in ( while ((i < iSizLAdmLvl) && (ret == nil)) do ( set ret = _DMSbyLoginI (strcat cliname (BLG_GetLoginExtensionI i)); if (ret != nil) then 0 else ( set ret = _DMSbyLoginI (strcat strcat cliname (BLG_GetLoginExtensionI i) "[away]"); 0; ); set i = i + 1; ); ret; ); );; /*------------*/ /*-1 if invalid login syntax -5 if login is not allowed nil if login refused else 0 or nb password left before expire*/ fun SetL(login, passwd, cli) = if (!strcmpi substr login 0 5 "guest") then /*guests are reserved for default names in DMS*/ -5 else if (!IsLoginSyntaxValid login) then /*invalid login syntax*/ -1 else let if (loginContentsCheck || open) then login else (GetValueColumnLoginContents login) -> cliName in /*connection login or another column*/ /* Bob Le Gob Modification: Original code: let _DMSbyLoginI cliName -> m in */ let BLG_CheckLoginExistence cliName -> m in /* Bob Le Gob Modification: End */ let hd SqlRequest db strcatn "SELECT "::LColName::", "::LColPasswd::","::LColNumber::" FROM "::LTable:: " WHERE "::LTable::"."::LColName::"=?"::nil (SQL_CHAR login)::nil-> [name[p [n _]]] in ( if (p == nil) then if ((!open) || ((m != nil) && (m != cli))) then nil else ( if ((IsAllowed login) == 0) then -5 else if (name == nil) then 0 else nil ) /*if name is in database, cannot be used by another person than the member*/ else let atoi n -> num in if (num == 0) then nil else if strcmp p signN passwd 1 then nil else ( if ((m != nil) && (m != cli)) then _DMSdelClient m else nil; if ((num - 1) <= ((wrnlog * maxlog) / 100)) then num - 1 else 0; ); );; /*------------*/ /*verifie si une condition de validité existe dans l'éditeur. Renvoie le resultat de cette condition si elle existe (test de la clause WHERE), sinon renvoie "OK"*/ fun VerifConditionValidite(login) = if (LColConditionValidite == nil) then /*pas de condition dans l'editeur DMI --> aucune verif de condition*/ "OK" else let hd hd SqlRequest db strcatn "SELECT "::LColName::" FROM "::LTable::" WHERE ":: LColName::"=?"::nil (SQL_CHAR login)::nil -> res in if (res == nil) then /*the login is not in the database, no validity condition*/ "OK" else hd hd SqlRequest db strcatn "SELECT "::LColName::" FROM "::LTable::" WHERE ":: LColName::"=? AND ("::LColConditionValidite::")"::nil (SQL_CHAR login)::nil;; /*------------*/ /*return nil if user not in database, 0 if NbechecConnexions has reached maxlogKo, else 1*/ fun VerifNbEchecConnexion(login) = let hd hd SqlRequest db strcatn "SELECT "::LColNbLogPasOK::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil-> nb in if (nb == nil) then nil else if ((atoi nb) >= maxlogKO) then 0 else 1;; /*------------*/ /*increase nb unsuccessfull login*/ fun IncreaseNbUnsuccessfullConnections(name) = SqlRequest db strcatn "UPDATE "::LTable::" SET "::LColNbLogPasOK::"="::LColNbLogPasOK::"+1"::" WHERE "::LColName::"=?;"::nil (SQL_CHAR name)::nil;; /*------------*/ /*refuse login*/ fun RefuseLogin(cli, name, passwd, res) = if (strcmp passwd "") && res==nil then /*increase nb unsuccessfull login only if password is not empty*/ IncreaseNbUnsuccessfullConnections name else nil; let VerifNbEchecConnexion name -> v in ( _DMSsend this cli CloginRefused [res v]; /*res==-1 if invalid login syntax, VerifNbEchecConnexion name==0 si utilisateur enregistré dans la base*/ _DMSevent this DMSsender "loginRefused" nil nil; if (v == 0) then /*client is deleted only if client is registered into database and the number of unsucessfull login is reached*/ _DMSdelClient cli else nil; );; /*------------*/ /*accept login*/ fun AcceptLogin(name, passwd) = /*init nb KO connection number*/ let ctime time -> dateEtHeure in SqlRequest db strcatn "UPDATE "::LTable::" SET "::LColPasswd::"=?,"::LColNbLogOK::"="::LColNbLogOK::"+1,"::LColNumber::"="::LColNumber::"-1,"::LColDateDerniereConnexion::"=?,"::LColNbLogPasOK::"=0"::" WHERE "::LColName::"=?;"::nil (SQL_CHAR passwd)::(SQL_CHAR dateEtHeure)::(SQL_CHAR name)::nil;; /*------------*/ /*returns nil if the login is not an administrator or if admin condition is the editor is nil*/ fun IsAdmin(login) = if (LColAdminLevel != nil) then hd hd SqlRequest db strcatn "SELECT "::LColName::" FROM "::LTable::" WHERE "::LColName::"=? AND ("::LColAdminLevel::")"::nil (SQL_CHAR login)::nil else nil;; /*------------*/ /*verify if the login is an administrator or a moderator, send events*/ fun UpdateAdminLevelItem(cli, login, old) = if (LColAdminLevel != nil) then let hd hd SqlRequest db strcatn "SELECT "::LColAdminLevel::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil -> name in if (name != nil) then ( _DMSsubItem cli adminLevelItemReference 10000; /*remove item (10000 to be sure quantity is 0!)*/ let mkItem [adminLevelItemReference name 1 nil] -> myItem in /*a changer, ajouter les fonctions dans dms*/ _DMSaddItem cli myItem; _DMSevent this DMSsender "loginChanged" old nil; _DMSevent this cli "loginChgIsAdmin" nil nil ) else ( _DMSsubItem cli adminLevelItemReference 10000; /*remove item (10000 to be sure quantity is 0!)*/ _DMSevent this DMSsender "loginChanged" old nil; _DMSevent this cli "loginChgIsNotAdmin" nil nil ) else _DMSevent this DMSsender "loginChanged" old nil;; fun BLG_GetAdminLevel(login) = if (LColAdminLevel != nil) then hd hd SqlRequest db strcatn "SELECT "::LColAdminLevel::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil else nil;; /*------------*/ /*if loginContentsCheck=1 or open=1, use login for user name*/ fun __setLogin(login, passwd) = let SetL login passwd DMSsender -> res in /*res==nil : invalid login syntax*/ let VerifConditionValidite login -> res2 in if ((res == -1) || (res == nil) || (res == -5)) then RefuseLogin DMSsender login passwd res else if (res2 == nil) then RefuseLogin DMSsender login passwd (-10) /*res2==nil : account disabled*/ else ( AcceptLogin login passwd; let _DMSgetLogin DMSsender -> old in /* Bob Le Gob Modification: Code added */ let BLG_GetAdminLevel login -> blg_admlvl in let if (blg_admlvl != nil) then strcat login (BLG_GetLoginExtensionS lAdminLevel blg_admlvl) else login -> blg_loginadmin in /* Bob Le Gob Modification: End - but blg_loginadmin is used later instead of former login if needed */ ( if (loginContentsCheck || open) then /*DMSlogin = connection login or another column*/ ( _DMSsetLogin DMSsender blg_loginadmin; _DMSsend this DMSsender CloginOk [blg_loginadmin res]; ) else let GetValueColumnLoginContents login -> otherLogin in ( _DMSsetLogin DMSsender otherLogin; _DMSsend this DMSsender CloginOk [otherLogin res]; ); if (open && ((ExistLogin login) == nil)) then /*we keep a list of the connected users that are not on the db in accept unregistered passwords*/ set lClisConnected = blg_loginadmin::(removef_from_list lClisConnected @cbCliByLogin old) /*add the client login to the current list of login used*/ else nil; UpdateAdminLevelItem DMSsender login old; /*if user is an admin, update admin ref item and send an event*/ ); );; /************************************************************************************************** Notes from Bob Le Gob: clients 'away'/'back' - Should the client change its login while 'away', he will then use the standard changing login process. There shouldn't be any conflict with the 'away'/'back' handling functions. - Should an unregistered client turn 'away', its unregistered login would then be available to new connecting clients. SetL() has been modified to prevent this. - The possibility to include administration level in the login induced further modifications in SetL() (cf BLG_CheckLoginExistence function) and new modifications in __setLogin(). **************************************************************************************************/ fun BLG_SetAway(cli) = let _DMSgetLogin cli -> old in if ((strfind "[away]" old 0) == nil) then let strcat old "[away]" -> login in ( _DMSsetLogin cli login; /* Changing login on server side */ _DMSsend this cli CloginOk [login 0]; /* Notifying login change to client */ if (open && ((ExistLogin old) == nil)) then /* cf __setLogin() - condition modified */ set lClisConnected = login::(removef_from_list lClisConnected @cbCliByLogin old) else nil; /* We do not call UpdateAdminLevelItem() as the client keeps his former admin level */ _DMSevent this cli "loginChanged" old nil; /* We just notify the changing of login */ 0; ) else 0;; fun BLG_SetBack(cli) = let _DMSgetLogin cli -> old in let strfind "[away]" old 0 -> strfound in if (strfound != nil) then let substr old 0 strfound -> login in ( _DMSsetLogin cli login; /* Changing login on server side */ _DMSsend this cli CloginOk [login 0]; /* Notifying login change to client */ if (open && ((ExistLogin login) == nil)) then /* cf __setLogin() */ set lClisConnected = login::(removef_from_list lClisConnected @cbCliByLogin old) else nil; /* We do not call UpdateAdminLevelItem() as the client keeps his former admin level */ _DMSevent this cli "loginChanged" old nil; /* We just notify the changing of login */ 0; ) else 0;; /*------------*/ fun cbActivate(from, cli, action, param, rep) = if !strcmp action "start" then _DMScreateClientDMI this cli linebuild BackgroundFileName::(cookie)::(itoa open)::(itoa becomeMember)::(itoa changePassword)::(itoa forgotPassword)::nil else if !strcmp action "away" then ( BLG_SetAway cli; 0; ) else if !strcmp action "back" then ( BLG_SetBack cli; 0; ) else if !strcmp action "editAdmin" then ( _DMSsend this cli CShowAdminInterface [GetNbRecords]; set lAdmins = cli::remove_from_list lAdmins cli; 0; ) else if !strcmp action "destroy" then ( _DMSdelClientDMI this cli; cbCliDestroyed cli; ) else if !strcmp action "check" then let strextr param -> l in let getInfo l "login" -> login in let getInfo l "password" -> password in let getInfo l "param" -> ownParam in let getInfo l "crypted" -> crypted in if (password == nil) then /*check only if login exist*/ let VerifConditionValidite login -> res2 in if (res2 == nil) then _DMSreply this cli from rep strbuild ("login"::login::nil)::("state"::"loginRefused"::nil)::("param"::ownParam::nil)::nil nil else if ((ExistLogin login) != nil) then _DMSreply this cli from rep strbuild ("login"::login::nil)::("state"::"loginNeedsPassword"::nil)::("param"::ownParam::nil)::nil nil else _DMSreply this cli from rep strbuild ("login"::login::nil)::("state"::"loginAccepted"::nil)::("param"::ownParam::nil)::nil nil else let if !strcmpi crypted "yes" then password else signN password atoi InitL login -> pwd in /*crypt password in necessary*/ let SetL login pwd cli -> res in let VerifConditionValidite login -> res2 in ( if (res == nil) then IncreaseNbUnsuccessfullConnections login else nil; if ((res == -1) || (res == nil) || (res2 == nil) || (res == -5)) then let VerifNbEchecConnexion login -> v in if (v == 0) then ( _fooS strcatn "### "::(_DMSgetName this)::" -> kill client "::login::" after 'check' action : too many password tries)"::nil; _DMSdelClient cli; /*del client*/ 0; ) else _DMSreply this cli from rep strbuild ("login"::login::nil)::("state"::"passwordRefused"::nil)::("param"::ownParam::nil)::nil nil else ( AcceptLogin login pwd; let _DMSbyLoginI login -> m in if (m != nil) then /*kill client if connected with this login*/ ( _fooS strcatn "### "::(_DMSgetName this)::" -> kill client "::login:: " after 'check' action : another client has registered with the good password"::nil; _DMSdelClient m; /*del client*/ 0; ) else nil; _DMSreply this cli from rep strbuild ("login"::login::nil)::("state"::"passwordAccepted"::nil)::("param"::ownParam::nil)::nil nil ) ) else nil;; /*------------*/ fun __initLogin(login) = _DMSsend this DMSsender CloginNum [InitL login];; /*------------*/ fun ParselNotAllowedStrings(l) = if (l == nil) then 0 else let l -> [t q] in ( if !strcmpi hd t "SUBSTRING" then set lNotAllowedSubStrings = (hd tl t)::lNotAllowedSubStrings else if !strcmpi hd t "STRING" then set lNotAllowedStrings = (hd tl t)::lNotAllowedStrings else nil; ParselNotAllowedStrings q; );; /*------------*/ fun cbReloadNotAllowedLogins(t, s) = set lNotAllowedSubStrings = nil; set lNotAllowedStrings = nil; let strextr _getpack _checkpack s -> l in if (l == nil) then nil else ParselNotAllowedStrings l; 0;; /******************************************************************************* Renvoie le login ou le password d'une base de donnes, on specifie l'alias dans odbcAlias, l'info que l'on souhaite reccueillir dans info ("login" ou "password") les valeurs sont recuperees dans usmress.ini format : odbc.odbcAlias.login odbc.odbcAlias.password attention : odbcAlias, infos ne doivent pas contenir les caracteres suivants : ".*?" *******************************************************************************/ fun GetODBCInfos(odbcAlias, info) = hd switchstr strextr _loadressini strcatn "odbc."::odbcAlias::"."::info::nil;; /*------------*/ fun IniDMI(param) = srand _tickcount;/*initialize random*/ _DMSregisterDMI this @cbActivate @cbCliDestroyed nil nil; let strextr _getpack _checkpack param -> l in ( set open = atoi getInfo l KW_OPEN; set cookie = getInfo l KW_COOKIE; set becomeMember = atoi getInfo l KW_BECOMEMEMBERBT; set changePassword = atoi getInfo l KW_CHANGEPASSWORDBT; set forgotPassword = atoi getInfo l KW_FORGOTPASSWORDBT; set dbname = getInfo l KW_DBNAME; if (dbname == nil) then nil else let GetODBCInfos dbname "login" -> login in /*test pour compatibilite ascendante*/ let GetODBCInfos dbname "password" -> password in ( set dblogin = if (login == nil) then getInfo l KW_DBLOGIN else login; set dbpassw = if (password == nil) then getInfo l KW_DBPASSW else password; ); if (dblogin == nil) then set dblogin = "" else nil; if (dbpassw == nil) then set dbpassw = "" else nil; set LTable = getInfo l KW_LTABLE; set LColName = getInfo l KW_LCOLNAME; set LColPasswd = getInfo l KW_LCOLPASSWD; set LColEmail = getInfo l KW_LCOLEMAIL; set LColNumber = getInfo l KW_LCOLNUMBER; set LColAdminLevel = getInfo l KW_LCOLADMINLEVEL; set adminLevelItemReference = getInfo l KW_ADMINLEVELITEMREFERENCE; set LColNbLogOK = getInfo l KW_LCOLLOGOK; set LColNbLogPasOK = getInfo l KW_LCOLLOGPASOK; set LColDateDerniereConnexion = getInfo l KW_LCOLDATELASTCONNECT; set LColConditionValidite = getInfo l KW_LCOLCONDVALIDITE; set emailSenderForgotPwd = getInfo l KW_EMAILSENDERFORGOTPWD; let getInfo l KW_NOTALLOWEDLOGINSFILE -> s in ( _rfltimer _starttimer _channel reloadnotAllowedLoginsFilePeriod*1000 @cbReloadNotAllowedLogins s; cbReloadNotAllowedLogins nil s; ); set loginContentsCheck = atoi getInfo l KW_LOGINCONTENTSCHECK; set loginContentsColumnName = getInfo l KW_LOGINCONTENTSCOLUMNNAME; set maxAccountPerEmail = atoi getInfo l KW_MAXLOGINSPEREMAIL; set initFieldsSetRequest = getInfo l KW_INITFIELDS; set BackgroundFileName = getInfo l KW_BACKGROUNDFILENAME; set maxlog = atoi getInfo l KW_MAXLOG; set maxlogKO = atoi getInfo l KW_MAXLOGKO; set wrnlog = atoi getInfo l KW_WRNLOG; ); set db = SqlCreate _channel dbname (if (dblogin == nil) then "" else dblogin) (if (dbpassw == nil) then "" else dbpassw); if (db == nil) then _adderror strcatn (_DMSgetName this)::" : unable to access to dataBase <"::dbname::">"::nil else nil; /*set lAdminLevel = ["0" ""]::["1" "@moderator"]::["2" "@admin"]::nil;*/ set lAdminLevel = ["0" ""]::["1" "@moderator"]::["2" "@admin"]::["3" "@ScoLProjecT"]::nil; set iSizLAdmLvl = sizelist lAdminLevel; 0;; /*******************************/ /*********** admin *************/ /*******************************/ /*------------*/ /*check if login exists, send email*/ fun __fetchLogin(login) = if ((search_in_list lAdmins @cbCliByCli DMSsender) == nil) then nil else let if (forgotPassword+becomeMember) then hd SqlRequest db strcatn "SELECT "::LColName::", "::LColEmail::", "::LColAdminLevel::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil else hd SqlRequest db strcatn "SELECT "::LColName::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil -> [RES_NAME[RES_EMAIL[RES_ADMINLEVEL _]]] in if (RES_NAME == nil) then /*login not found*/ _DMSsend this DMSsender CresultFetch [0 nil nil nil] else if ((SqlCod db)!=SQL_SUCCESS) then /*service not available*/ _DMSsend this DMSsender CresultFetch [nil nil nil nil] else /*ok*/ _DMSsend this DMSsender CresultFetch [1 RES_EMAIL maxlog RES_ADMINLEVEL];; /*------------*/ /*update db with new password or email*/ fun __adminChangeInfo (Slogin, SnewPassword, SnewEmail, SnewAdminLevel, l)= if ((search_in_list lAdmins @cbCliByCli DMSsender) == nil) then nil else ( if (SnewPassword == nil) then /*do not update password*/ if (forgotPassword+becomeMember) then ( SqlRequest db strcatn "UPDATE "::LTable::" SET "::LColAdminLevel::"=?, "::LColEmail::"=? WHERE "::LColName::"=?;"::nil (SQL_CHAR SnewAdminLevel)::(SQL_CHAR SnewEmail)::(SQL_CHAR Slogin)::nil; if ((SqlCod db) == SQL_SUCCESS) then /*ok*/ _DMSsend this DMSsender CupdateResult [1] else /*service not available*/ _DMSsend this DMSsender CupdateResult [0] ) else /*no email*/ nil else if ((l < min_password_length) || (l > max_password_length)) then /*password length error*/ _DMSsend this DMSsender CupdateResult [-1] else ( if (forgotPassword + becomeMember) then ( SqlRequest db strcatn "UPDATE "::LTable:: " SET "::LColAdminLevel::"=?, "::LColPasswd::"=?, "::LColEmail::"=?, "::LColNumber::"=?,"::LColNbLogPasOK::"=?":: " WHERE "::LColName::"=?;"::nil (SQL_CHAR SnewAdminLevel)::(SQL_CHAR SnewPassword)::(SQL_CHAR SnewEmail)::(SQL_INTEGER itoa maxlog -1)::(SQL_INTEGER "0")::(SQL_CHAR Slogin)::nil; 0; ) else /*no email*/ ( SqlRequest db strcatn "UPDATE "::LTable:: " SET "::LColAdminLevel::"=?, "::LColPasswd::"=?, "::LColNumber::"=?,"::LColNbLogPasOK::"=?":: " WHERE "::LColName::"=?;"::nil (SQL_CHAR SnewAdminLevel)::(SQL_CHAR SnewPassword)::(SQL_INTEGER itoa maxlog -1)::(SQL_INTEGER "0")::(SQL_CHAR Slogin)::nil; 0; ); if ((SqlCod db) == SQL_SUCCESS) then /*ok*/ _DMSsend this DMSsender CupdateResult [1] else /*service not available*/ _DMSsend this DMSsender CupdateResult [0] ); );; /*******************************/ /******** become member ********/ /*******************************/ /*------------*/ /*check if login is not already in db*/ /*or login currently used by a client*/ /*record the login into database*/ /*send a random password to the user by email*/ fun __becomeMember(login, email) = if !becomeMember then nil else if (!IsLoginSyntaxValid login) then _DMSsend this DMSsender CresultBecomeMember [2] /*invalid login syntax*/ else if (IsAllowed login)==0 then _DMSsend this DMSsender CresultBecomeMember [6] /*login not allowed*/ else if (ExistLogin login)!=nil then _DMSsend this DMSsender CresultBecomeMember [1] /*login already reserved*/ else if (strcmp login (_DMSgetLogin DMSsender)) && (search_in_list lClisConnected @cbCliByLogin login)!=nil then _DMSsend this DMSsender CresultBecomeMember [4] /*login already used by another connected client, but login is not reserved*/ else if (IsAdmin _DMSgetLogin DMSsender)==nil && (GetNbUserAccount email) >= maxAccountPerEmail then _DMSsend this DMSsender CresultBecomeMember [5] /*too many accounts for this email (unlimited if user is currently logged as an administrator)*/ else let _getlongname BigToAsc BigRand "" "#" -> s in let substr s 1 5 -> randomPassword in ( SqlRequest db strcatn "INSERT INTO "::LTable::"("::LColName::","::LColEmail::","::LColPasswd::","::LColNumber::") VALUES (?,?,?,?);"::nil (SQL_CHAR login)::(SQL_CHAR email)::(SQL_CHAR signN randomPassword maxlog)::(SQL_INTEGER itoa maxlog-1)::nil; if ((SqlCod db) == SQL_SUCCESS) then ( if initFieldsSetRequest!=nil then /*initialize account extra fields*/ SqlRequest db strcatn "UPDATE "::LTable::" "::initFieldsSetRequest::" WHERE "::LColName::"=?;"::nil (SQL_CHAR login)::nil else nil; _DMSevent this DMSsender "newUserRegistered" nil nil; _DMSsend this DMSsender CresultBecomeMember [0]; /*OK*/ _DMSevent this nil "sendPwdEmail" strbuild /*send the new password by email*/ (("snd"::(emailSenderForgotPwd)::nil):: ("rcp"::email::nil):: ("sub"::(_loc this "EMAIL_SUBJECT" DMSname::nil)::nil):: ("txt"::(_loc this "EMAIL_CONTENTS" login::DMSname::randomPassword::nil)::nil)::nil) nil; ) else _DMSsend this DMSsender CresultBecomeMember [3]; /*ERROR*/ 0; );; /*******************************/ /******* forgot password *******/ /*******************************/ /*------------*/ /*called when user click on forgot password button*/ fun __forgotPassword(login, email)= if !forgotPassword then nil else let hd hd SqlRequest db strcatn "SELECT "::LColEmail::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil -> RES in if strcmp email RES then _DMSsend this DMSsender CresultForgotPassword [1] /*incorrect email and/or login*/ else let _getlongname BigToAsc BigRand "" "#" -> s in let substr s 1 5 -> newPassword in ( SqlRequest db strcatn "UPDATE "::LTable:: /*update new crypted password into database*/ " SET "::LColPasswd::"=?, "::LColNumber::"=?,"::LColNbLogPasOK::"=?":: " WHERE "::LColName::"=?;"::nil (SQL_CHAR signN newPassword maxlog)::(SQL_INTEGER itoa maxlog -1)::(SQL_INTEGER "0")::(SQL_CHAR login)::nil; if ((SqlCod db) == SQL_SUCCESS) then ( _DMSsend this DMSsender CresultForgotPassword [0]; /*OK*/ _DMSevent this nil "sendPwdEmail" strbuild /*send the new password by email*/ (("snd"::(emailSenderForgotPwd)::nil):: ("rcp"::email::nil):: ("sub"::(_loc this "EMAIL_SUBJECT" DMSname::nil)::nil):: ("txt"::(_loc this "EMAIL_CONTENTS" login::DMSname::newPassword::nil)::nil)::nil) nil; ) else _DMSsend this DMSsender CresultForgotPassword [3]; /*ERROR*/ ); 0;; /*******************************/ /******** change password ******/ /*******************************/ /*------------*/ /*called when user click on change password button*/ /*send the number to crypt password*/ /*inform the client if login is incorrect*/ fun __askChangePassword(login, l) = if !changePassword then nil else if (lmax_password_length) then _DMSsend this DMSsender CresultChangePassword [4] /*incorrect password length*/ else let atoi InitL login -> n in /*returns nil if incorrect login*/ if (n != nil) then _DMSsend this DMSsender CresultAskChangePassword [login n maxlog] else _DMSsend this DMSsender CresultChangePassword [1];; /*incorrect login*/ /*------------*/ /*check again if login is correct (should already be done in __askChangePassword)*/ /*update new password into database if old password is correct*/ fun __changePassword(login, oldPwd, newPwd) = if !changePassword then nil else let VerifNbEchecConnexion login -> res in /*nil if incorrect login*/ if (res == nil) then /*should already be done*/ _DMSsend this DMSsender CresultChangePassword [1] /*incorrect login/old password*/ else let hd hd SqlRequest db strcatn "SELECT "::LColPasswd::" FROM "::LTable::" WHERE "::LColName::"=?"::nil (SQL_CHAR login)::nil -> RES in ( if strcmp oldPwd RES then /*incorrect password*/ ( _DMSsend this DMSsender CresultChangePassword [1]; /*incorrect login/old password*/ IncreaseNbUnsuccessfullConnections login; if (res == 0) then _DMSdelClient DMSsender else nil;/*if reached nb max unsuccesfull login*/ ) else ( SqlRequest db strcatn "UPDATE "::LTable:: /*update new crypted password into database*/ " SET "::LColPasswd::"=?, "::LColNumber::"=?,"::LColNbLogPasOK::"=?":: " WHERE "::LColName::"=?;"::nil (SQL_CHAR newPwd)::(SQL_INTEGER itoa maxlog -1)::(SQL_INTEGER "0")::(SQL_CHAR login)::nil; if ((SqlCod db) == SQL_SUCCESS) then _DMSsend this DMSsender CresultChangePassword [0] /*OK*/ else _DMSsend this DMSsender CresultChangePassword [3]; /*ERROR*/ ); ); 0;;