Démarrage de l'application Shiny après la saisie du mot de passe
Je sais que dans Shiny Server Pro il y a une fonction de contrôle de mot de passe. La question est que Shiny a la fonction passwordInput (), qui est comme textInput (). Quelqu'un a-t-il pensé à comment faire ce qui suit:
1) Lancement de l'application uniquement après la saisie du mot de passe correct 2) Lancement de la partie de l'application après la saisie du mot de passe correct (par exemple, j'ai quelques onglets dans shinydashboard, et je veux accéder à l'un d'eux uniquement par mot de passe)
Merci!
Je vais répondre # 1 et pour # 2 vous pouvez simplement développer mon exemple. En suivant cet exemple Crypter le mot de passe avec md5 pour Shiny-app. vous pouvez faire ce qui suit:
1) Créez 2 pages et si l'utilisateur entre le nom d'utilisateur et le mot de passe corrects, vous pouvez renderUI et utiliser htmlOutput pour sortir votre page 2) Vous pouvez styliser la position de la boîte avec nom d'utilisateur et mot de passe avec tagscomme je l'ai fait et coloriez-les si vous voulez aussi utiliser tags$style
Vous pouvez ensuite approfondir la page réelle et spécifier ce qui doit être créé à la suite de différents utilisateurs. Vous pouvez également regarder dans JavaScript Popup Boxes
EDIT 2018: Regardez également l'exemple ici https://shiny.rstudio.com/gallery/authentication-and-database .html
rm(list = ls())
library(shiny)
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){tagList(tabPanel("Test"))}
ui = (htmlOutput("page"))
server = (function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
observe({
if (USER$Logged == FALSE) {
if (!is.null(input$Login)) {
if (input$Login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
Id.username <- which(my_username == Username)
Id.password <- which(my_password == Password)
if (length(Id.username) > 0 & length(Id.password) > 0) {
if (Id.username == Id.password) {
USER$Logged <- TRUE
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
})
print(ui)
}
})
})
runApp(list(ui = ui, server = server))
J'ai dû poser la même question, suis tombé sur la réponse ci-dessus et l'ai trouvé trop difficile à mettre en œuvre. Apparemment, il y a eu d'autres tilisateurs sur SO avec des problèmes similaires pour implémenter la solution ci-dessus.
J'ai construit une solution de contournement beaucoup plus simple en utilisant l'onglet ajouter/supprimer et shinyjs. Voici comment cela fonctionne. Cela pourrait aider ceux qui ne veulent pas travailler avec deux fonctions d'interface utilisateur distinctes.
- Créez un onglet de connexion où les utilisateurs peuvent se connecter. Tous les autres onglets ne sont pas encore affichés, pas plus que la barre latérale.
- Une fois la connexion réussie: ajoutez les onglets que vous souhaitez afficher, supprimez l'onglet de connexion (il n'est plus nécessaire) et affichez la barre latérale avec shinyjs.
Je donne un exemple simple ci-dessous. J'ai en outre ajouté des fonctionnalités qui ne sont pas nécessaires comme le comptage de l'historique utilisateur et la limitation du nombre de tentatives de connexion, un journal utilisateur et un gestionnaire de messages, etc. J'ai commenté ces fonctionnalités pour simplifier les choses, mais si vous êtes intéressé, regardez. Veuillez noter que les fonctionnalités supplémentaires doivent être exécutées sur un serveur.
Le seul inconvénient de ne pas utiliser Shiny Server Pro est la connexion https manquante, qui doit être ajoutée avec ne autre solution si vraiment nécessaire.
J'ai documenté un exemple simple et un approche avec des fonctionnalités supplémentaires sur GitHub. Une version de travail de ce dernier peut être trouvée sur shinyapps.io .
Ci-dessous, je poste le code de la version plus simple de l'application en se concentrant sur la connexion elle-même.
Les noms d'utilisateur et mots de passe requis pour la connexion sont les suivants:
username password
user123 loginpassword1
user456 loginpassword2
Dans une vraie application, ils doivent être stockés sous forme de hachages sur le serveur.
library("shiny")
library("shinyjs")
library("stringr")
# in case you want to send error messages when login is wrong
# add this to the /www folder in your shiny app (shiny server) as message-handler.js file
#
# // This recieves messages of type "testmessage" from the server.
# Shiny.addCustomMessageHandler("testmessage",
# function(message) {
# alert(JSON.stringify(message));
# }
# );
shinyApp(
ui = fluidPage(
useShinyjs(), # Set up shinyjs
# Layout mit Sidebar
sidebarLayout(
## Sidebar -----
shinyjs::hidden(
div(id = "Sidebar", sidebarPanel(
# > some example input on sidebar -----
conditionalPanel(
condition = "input.tabselected > 1",
dateRangeInput(inputId = "date",
label = "Choose date range",
start = "2018-06-25", end = "2019-01-01",
min = "2018-06-25", max = "2019-01-01",
startview = "year"))
))), # closes Sidebar-Panel
# Main-Panel ------
mainPanel(
tabsetPanel(
# > Login -------
tabPanel("Login",
value = 1,
br(),
textInput("username", "Username"),
passwordInput("password", label = "Passwort"),
# If you want to add custom javascript messages
# tags$head(tags$script(src = "message-handler.js")),
actionButton("login", "Login"),
textOutput("pwd")
), # closes tabPanel
id = "tabselected", type = "pills"
) # closes tabsetPanel
) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
# Server ------
server = function(input, output, session){
user_vec <- c("user123" = "loginpassword1",
"user456" = "loginpassword2")
# I usually do run the code below on a real app on a server
# user <- reactiveValues(his = readRDS(file = "logs/user_his.rds"),
# log = readRDS(file = "logs/user_log.rds"),
# vec = readRDS(file = "logs/user_vec.rds"))
#
# where user_his is defined as follows
# user_his <- vector(mode = "integer", length = length(user_vec))
# names(user_his) <- names(user_vec)
observeEvent(input$login, {
if (str_to_lower(input$username) %in% names(user_vec)) { # is username in user_vec?
# Alternatively if you want to limit login attempts to "3" using the user_his file
# if (str_to_lower(input$username) %in% names(user$vec[user$his < 3])) {
if (input$password == unname(user_vec[str_to_lower(input$username)])) {
# nulls the user_his login attempts and saves this on server
# user$his[str_to_lower(input$username)] <- 0
# saveRDS(user$his, file = "logs/user_his.rds")
# Saves a temp log file
# user_log_temp <- data.frame(username = str_to_lower(input$username),
# timestamp = Sys.time())
# saves temp log in reactive value
# user$log <- rbind(user$log, user_log_temp)
# saves reactive value on server
# saveRDS(user$log, file = "logs/user_log.rds")
# > Add MainPanel and Sidebar----------
shinyjs::show(id = "Sidebar")
appendTab(inputId = "tabselected",
tabPanel("Tab 1",
value = 2
) # closes tabPanel,
)
appendTab(inputId = "tabselected",
tabPanel("Tab 2",
value = 3
) # closes tabPanel,
)
appendTab(inputId = "tabselected",
tabPanel("Tab 3",
value = 4
) # closes tabPanel
)
removeTab(inputId = "tabselected",
target = "1")
} else { # username correct, password wrong
# adds a login attempt to user_his
# user$his[str_to_lower(input$username)] <- user$his[str_to_lower(input$username)] + 1
# saves user_his on server
# saveRDS(user$his, file = "logs/user_his.rds")
# Messge which shows how many log-in tries are left
#
# session$sendCustomMessage(type = 'testmessage',
# message = paste0('Password not correct. ',
# 'Remaining log-in tries: ',
# 3 - user$his[str_to_lower(input$username)]
# )
# )
} # closes if-clause
} else { # username name wrong or more than 3 log-in failures
# Send error messages with javascript message handler
#
# session$sendCustomMessage(type = 'testmessage',
# message = paste0('Wrong user name or user blocked.')
# )
} # closes second if-clause
}) # closes observeEvent
} # Closes server
) # Closes ShinyApp