密码输入后启动Shiny app
我知道在Shiny Server Pro中有一个密码控制功能。 问题是Shiny有函数passwordInput（），就像textInput（） 有没有人想过如何做到以下几点：
1）仅在输入正确的密码后启动应用程序 2）在输入正确的密码后启动应用程序的一部分（例如，我在shinydashboard中有一些选项卡，我想只通过密码访问其中一个）
谢谢！
5 个答案:
答案 0 :(得分：49)
我将回答＃1，对于＃2，你可以简单地扩展我的例子。按照此示例Encrypt password with md5 for Shiny-app.，您可以执行以下操作：
1）创建2个页面，如果用户输入了正确的用户名和密码，您可以renderUI并使用htmlOutput输出您的页面
2）你可以像我一样使用tags的用户名和密码来设置方框的位置，如果你想使用tags$style
然后，您可以进一步查看实际页面，并指定由于不同用户而应创建的内容。您还可以查看JavaScript Popup Boxes
EDIT 2018：另请查看此处的示例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))
答案 1 :(得分：1)
另一种设置密码的简单方法是使用 req() 并设置特定的密码值：
library(shiny)
if (interactive()) {
ui <- fluidPage(
passwordInput("password", "Password:"),
actionButton("go", "Go"),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({
req(input$password == "hi")
req(input$go)
isolate(input$password)
})
}
shinyApp(ui, server)
}
答案 2 :(得分：0)
我不得不问同样的问题，偶然发现了以上答案，发现我很难实施。显然，SO上还有其他users，也存在类似问题，可以实现上述解决方案。
我使用append / remove选项卡和Shinyjs构建了一个更简单的解决方法。下面是它的工作原理。这可能会帮助那些不想使用两个单独的UI函数的人。
- 创建一个登录选项卡，用户可以在其中登录。所有其他选项卡尚未显示，边栏也未显示。
- 登录成功后： 附加您实际想要显示的选项卡，删除登录选项卡（不再需要该选项卡），然后使用shinyjs显示侧栏。
我在下面提供一个简单的示例。我还添加了一些不必要的功能，例如用户历史记录计数和限制登录尝试的次数，用户日志和消息处理程序等。我注释掉了这些功能是为了使事情变得简单，但是如果您有兴趣的话，请看一下。请注意，附加功能必须在服务器上运行。
不使用闪亮的服务器专业版的唯一缺点是缺少https连接，如果确实有必要，则需要在another work-around处添加。
登录所需的用户名和密码如下：
username password
user123 loginpassword1
user456 loginpassword2
在真实应用中，它们应作为哈希存储在服务器上。
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
答案 3 :(得分：0)
对于晶振仪表板，这可能也有帮助
library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)
# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br(),
br(),
tags$code("Username: myuser Password: mypass"),
br(),
tags$code("Username: myuser1 Password: mypass1")
))
)
credentials = data.frame(
username_id = c("myuser", "myuser1"),
passod = sapply(c("mypass", "mypass1"),password_store),
permission = c("basic", "advanced"),
stringsAsFactors = F
)
header <- dashboardHeader( title = "Simple Dashboard", uiOutput("logoutbtn"))
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body"))
ui<-dashboardPage(header, sidebar, body, skin = "blue")
server <- function(input, output, session) {
login = FALSE
USER <- reactiveValues(login = login)
observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})
output$logoutbtn <- renderUI({
req(USER$login)
tags$li(a(icon("fa fa-sign-out"), "Logout",
href="javascript:window.location.reload(true)"),
class = "dropdown",
style = "background-color: #eee !important; border: 0;
font-weight: bold; margin:5px; padding: 10px;")
})
output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
sidebarMenu(
menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
)
}
})
output$body <- renderUI({
if (USER$login == TRUE ) {
tabItem(tabName ="dashboard", class = "active",
fluidRow(
box(width = 12, dataTableOutput('results'))
))
}
else {
loginpage
}
})
output$results <- DT::renderDataTable({
datatable(iris, options = list(autoWidth = TRUE,
searching = FALSE))
})
}
runApp(list(ui = ui, server = server), launch.browser = TRUE)
答案 4 :(得分：0)
除了第一个答案之外，您还可以通过将 Shinymanager 与 scrypt 包结合使用来轻松加密您的密码。为此，您可以先生成一个密码并对其进行哈希处理：
library(scrypt)
password <- hashPassword("ice")
password #copy this hashed output and then paste it in your app's code
现在，如果我们采用前面的示例，那么修改它所需要做的就是创建一个具有散列值的对象（不是原始值）并设置 is_hashed_password 参数在 TRUE 的凭据内。
您无需将原始密码存储在脚本中即可访问应用程序（用户名：1）。
library(shiny)
library(shinymanager)
library(scrypt)
inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer; // catches mouse clicks
window.onscroll = resetTimer; // catches scrolling
window.onkeypress = resetTimer; //catches keyboard actions
function logout() {
window.close(); //close the window
}
function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 120000); // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"
password <- "c2NyeXB0ABAAAAAIAAAAAVYhtzTyvRJ9e3hYVOOk63KUzmu7rdoycf3MDQ2jKLDQUkpCpweMU3xCvI3C6suJbKss4jrNBxaEdT/fBzxJitY3vGABhpPahksMpNu/Jou5"
# data.frame with credentials info
credentials <- data.frame(
user = c("1", "fanny", "victor", "benoit"),
password = password,
is_hashed_password = TRUE,
# comment = c("alsace", "auvergne", "bretagne"), %>%
stringsAsFactors = FALSE
)
ui <- secure_app(head_auth = tags$script(inactivity),
fluidPage(
# classic app
headerPanel('Iris k-means clustering'),
sidebarPanel(
selectInput('xcol', 'X Variable', names(iris)),
selectInput('ycol', 'Y Variable', names(iris),
selected=names(iris)[[2]]),
numericInput('clusters', 'Cluster count', 3,
min = 1, max = 9)
),
mainPanel(
plotOutput('plot1'),
verbatimTextOutput("res_auth")
)
))
server <- function(input, output, session) {
result_auth <- secure_server(check_credentials = check_credentials(credentials))
output$res_auth <- renderPrint({
reactiveValuesToList(result_auth)
})
# classic app
selectedData <- reactive({
iris[, c(input$xcol, input$ycol)]
})
clusters <- reactive({
kmeans(selectedData(), input$clusters)
})
output$plot1 <- renderPlot({
palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
"#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
par(mar = c(5.1, 4.1, 0, 1))
plot(selectedData(),
col = clusters()$cluster,
pch = 20, cex = 3)
points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
})
}
shinyApp(ui = ui, server = server)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？