add options for validity pwd & update check same / old pwd

NEWS.md

@@ -8,6 +8,7 @@
 * (#113) disable download db & logs. Thanks @StatisMike
 * (#130) update somes icons. Thanks @ismirsehregal
 * add download user file
+* add options for validity pwd & update check same / old pwd
 
 # shinymanager 1.0.400
 

R/credentials-db.R

@@ -88,7 +88,7 @@ create_db <- function(credentials_data, sqlite_path, passphrase = NULL) {
       user = credentials_data$user,
       must_change = as.character(FALSE),
       have_changed = as.character(FALSE),
-      date_change = character(length(credentials_data$user)),
+      date_change = as.character(Sys.Date()),
       stringsAsFactors = FALSE
     ),
     passphrase = passphrase

R/language.R

@@ -8,6 +8,7 @@ pkgEnv$label_en = list(
   "Username or password are incorrect" = "Username or password are incorrect",
   "Your account has expired" = "Your account has expired",
   "Please change your password" = "Please change your password",
+  "New password cannot be the same as old" = "New password cannot be the same as old",
   "New password:" = "New password :",
   "Confirm password:" = "Confirm password :",
   "Update new password" = "Update new password",
@@ -92,6 +93,7 @@ pkgEnv$label_fr = list(
   "Username or password are incorrect" = "Nom d\'utilisateur ou mot de passe incorrect",
   "Your account has expired" = "Votre compte a expir\u00e9",
   "Please change your password" = "Veuillez changer votre mot de passe",
+  "New password cannot be the same as old" = "Le nouveau mot de passe est identique \u00e0 l\'actuel",
   "New password:" = "Nouveau mot de passe :",
   "Confirm password:" = "Confirmez le mot de passe :",
   "Update new password" = "Mettre \u00e0 jour",
@@ -176,6 +178,7 @@ pkgEnv$label_ptbr = list(
   "Username or password are incorrect" = "Usu\u00e1rio ou senha incorreto",
   "Your account has expired" = "Sua conta expirou",
   "Please change your password" = "Por favor, mude sua senha",
+  "New password cannot be the same as old" = "As nova senha n\u00e3o podem ser as mesmas que as anteriore",
   "New password:" = "Nova senha :",
   "Confirm password:" = "Confirmar nova senha:",
   "Update new password" = "Atualizar nova senha",
@@ -260,6 +263,7 @@ pkgEnv$label_es = list(
   "Username or password are incorrect" = "Usuario o contrase\u00f1a incorrecto",
   "Your account has expired" = "Su cuenta ha expirado",
   "Please change your password" = "Por favor, cambie su contrase\u00f1a",
+  "New password cannot be the same as old" = "La nueva contrase\u00f1a no puede ser la misma que la anterior",
   "New password:" = "Nueva contrase\u00f1a:",
   "Confirm password:" = "Confirme contrase\u00f1a:",
   "Update new password" = "Actualizar nueva contrase\u00f1a",
@@ -344,6 +348,7 @@ pkgEnv$label_de = list(
   "Username or password are incorrect" = "Benutzername oder Passwort falsch",
   "Your account has expired" = "Account ist abgelaufen",
   "Please change your password" = "Bitte Passwort \u00e4ndern",
+  "New password cannot be the same as old" = "Das neue Passwort kann nicht dasselbe sein wie das vorherige",
   "New password:" = "Neues Passwort :",
   "Confirm password:" = "Passwort best\u00e4tigen :",
   "Update new password" = "Passwort aktualisieren",
@@ -428,6 +433,7 @@ pkgEnv$label_pl = list(
   "Username or password are incorrect" = "Nazwa u\u017cytkownika lub has\u0142o s\u0105 nieprawid\u0142owe",
   "Your account has expired" = "Twoje konto jest nieaktywne",
   "Please change your password" = "Prosz\u0119 zmieni\u0107 has\u0142o",
+  "New password cannot be the same as old" = "Nowe has\u0142o nie mo\u017ce by\u0107 takie samo jak poprzednie",
   "New password:" = "Nowe has\u0142o :",
   "Confirm password:" = "Potwierd\u017a has\u0142o :",
   "Update new password" = "Zaktualizuj has\u0142o",
@@ -512,6 +518,7 @@ pkgEnv$label_ja = list(
   "Username or password are incorrect" = "\u30e6\u30fc\u30b6\u30fc\u540d\u307e\u305f\u306f\u30d1\u30b9\u30ef\u30fc\u30c9\u304c\u6b63\u3057\u304f\u3042\u308a\u307e\u305b\u3093",
   "Your account has expired" = "\u30a2\u30ab\u30a6\u30f3\u30c8\u306e\u6709\u52b9\u671f\u9650\u304c\u5207\u308c\u3066\u3044\u307e\u3059",
   "Please change your password" = "\u30d1\u30b9\u30ef\u30fc\u30c9\u3092\u5909\u66f4\u3057\u3066\u304f\u3060\u3055\u3044",
+  "New password cannot be the same as old" = "\u30d1\u30b9\u30ef\u30fc\u30c9\u306e\u66f4\u65b0\u306b\u5931\u6557\u3057\u307e\u3057\u305f",
   "New password:" = "\u65b0\u3057\u3044\u30d1\u30b9\u30ef\u30fc\u30c9 :",
   "Confirm password:" = "\u30d1\u30b9\u30ef\u30fc\u30c9\u306e\u78ba\u8a8d :",
   "Update new password" = "\u30d1\u30b9\u30ef\u30fc\u30c9\u306e\u66f4\u65b0",

R/module-admin.R

@@ -559,7 +559,7 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
         user = newuser$user,
         must_change = must_change,
         have_changed = as.character(FALSE),
-        date_change = character(1),
+        date_change = as.character(Sys.Date()),
         stringsAsFactors = FALSE
       ))
       write_db_encrypt(conn = conn, value = resetpwd, name = "pwd_mngt", passphrase = passphrase)

R/module-pwd.R

@@ -127,6 +127,7 @@ pwd_server <- function(input, output, session, user, update_pwd, validate_pwd =
   observeEvent(input$update_pwd, {
     password$relog <- NULL
     removeUI(selector = jns("msg_pwd"))
+
     if (!identical(input$pwd_one, input$pwd_two)) {
       insertUI(
         selector = jns("result_pwd"),
@@ -135,6 +136,14 @@ pwd_server <- function(input, output, session, user, update_pwd, validate_pwd =
           icon("exclamation-triangle"), lan()$get("The two passwords are different")
         )
       )
+    } else if (!check_new_pwd(user$user, input$pwd_one)) {
+      insertUI(
+        selector = jns("result_pwd"),
+        ui = tags$div(
+          id = ns("msg_pwd"), class = "alert alert-danger",
+          icon("exclamation-triangle"), lan()$get("New password cannot be the same as old")
+        )
+      )
     } else {
       if (!isTRUE(validate_pwd(input$pwd_one))) {
         insertUI(

R/secure-app.R

@@ -204,6 +204,10 @@ secure_app <- function(ui,
 #' sqlite database, \code{options("shinymanager.download" = "logs")} to allow logs download
 #' or \code{options("shinymanager.download" = "")} to disable all.  
 #'
+#' Using \code{options("shinymanager.pwd_validity")}, you can set password validity period. It defaults
+#' to \code{Inf}. You can specify for example
+#' \code{options("shinymanager.pwd_validity" = 90)} if you want to force user changing password each 90 days.
+#' 
 #' @export
 #'
 #' @importFrom shiny callModule getQueryString parseQueryString

R/utils.R

@@ -15,6 +15,10 @@ get_download <- function(){
   getOption("shinymanager.download", default = c("db", "logs", "users"))
 }
 
+get_pwd_validity <- function(){
+  getOption("shinymanager.pwd_validity", default = Inf)
+}
+
 get_args <- function(..., fun) {
   args_fun <- names(formals(fun))
   args <- list(...)
@@ -44,7 +48,19 @@ is_force_chg_pwd <- function(token) {
     on.exit(dbDisconnect(conn))
     resetpwd <- read_db_decrypt(conn, name = "pwd_mngt", passphrase = passphrase)
     ind_user <- resetpwd$user %in% user_info$user
-    identical(resetpwd$must_change[ind_user], "TRUE")
+    # first check must change
+    res <- identical(resetpwd$must_change[ind_user], "TRUE")
+    # then pwd_validity
+    if(!res){
+      pwd_validity <- as.numeric(get_pwd_validity())
+      if(length(pwd_validity) > 0 && !is.na(pwd_validity)){
+        user_date <- as.Date(resetpwd$date_change[ind_user])
+        if(!is.na(user_date)){
+          res <- as.numeric(difftime(Sys.Date(), user_date, units = "days")) > pwd_validity
+        }
+      }
+    }
+    return(res)
   } else {
     return(FALSE)
   }
@@ -80,9 +96,6 @@ update_pwd <- function(user, pwd) {
     res_pwd <- try({
       users <- read_db_decrypt(conn, name = "credentials", passphrase = passphrase)
       ind_user <- users$user %in% user
-      if (identical(users$password[ind_user], pwd)) {
-        return(list(result = FALSE))
-      }
       if(!"character" %in% class(users$password)){
         users$password <- as.character(users$password)
       }
@@ -100,6 +113,32 @@ update_pwd <- function(user, pwd) {
   }
 }
 
+#' @importFrom DBI dbConnect dbDisconnect
+#' @importFrom RSQLite SQLite
+check_new_pwd <- function(user, pwd) {
+  sqlite_path <- .tok$get_sqlite_path()
+  passphrase <- .tok$get_passphrase()
+  if (!is.null(sqlite_path)) {
+    conn <- dbConnect(SQLite(), dbname = sqlite_path)
+    on.exit(dbDisconnect(conn))
+    res_pwd <- try({
+      users <- read_db_decrypt(conn, name = "credentials", passphrase = passphrase)
+      ind_user <- users$user %in% user
+      if("is_hashed_password" %in% colnames(users)){
+        if(users$is_hashed_password[ind_user]){
+          return(!scrypt::verifyPassword(users$password[ind_user], pwd))
+        }
+      } else {
+        return(!identical(users$password[ind_user], pwd))
+      }
+    }, silent = TRUE)
+    if("try-error" %in% class(res_pwd)) res_pwd <- TRUE
+    return(res_pwd)
+  } else {
+    return(TRUE)
+  }
+}
+
 
 #' @importFrom DBI dbConnect dbDisconnect
 #' @importFrom RSQLite SQLite