输入密码后启动Shiny应用程序 [英] Starting Shiny app after password input

问题描述

我知道Shiny Server Pro中具有密码控制功能. 问题是，Shiny具有函数passwordInput()，类似于textInput() 有没有人考虑过如何做以下事情:

I know that in Shiny Server Pro there is a function of password control. The question is that Shiny has function passwordInput(), which is like textInput() Has anybody thought about how to do the following:

1)仅在输入正确的密码后启动应用程序 2)输入正确的密码后启动应用程序的一部分(例如，我在Shinydashboard中有一些选项卡，并且我只想通过密码访问其中一个选项卡)

1) Launching the application only after correct password input 2) Launching the part of application after correct password input (for example, I have some tabs in shinydashboard, and I want to make an acces to one of them only by password)

谢谢！

推荐答案

EDIT 2019 :现在，我们可以使用包shinymanager来执行此操作:invactivity脚本将使登录超时闲置2分钟后进入页面，因此您不会浪费资源:

EDIT 2019: We can now use the package shinymanager to do this: the invactivity script is to timeout the login page after 2 mins of inactivity so you dont waste resorces:

library(shiny)
library(shinymanager)

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();"


# data.frame with credentials info
credentials <- data.frame(
  user = c("1", "fanny", "victor", "benoit"),
  password = c("1", "azerty", "12345", "azerty"),
  # 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)

原始帖子: 我将回答#1，对于#2，您可以简单地扩展我的示例.按照此示例使用md5加密Shiny-app的密码.您可以执行以下操作:

Original Post: I am going to answer #1 and for #2 you can simply expand on my example. Following this example Encrypt password with md5 for Shiny-app. you can do the following:

1)创建2个页面，如果用户输入正确的用户名和密码，则可以renderUI并使用htmlOutput输出页面 2)您可以像我一样使用tags为用户名和密码设置框的位置样式，并根据需要使用tags$style

1) Create 2 pages and if the user inputs the correct username and password you can renderUI and use htmlOutput to output your page 2) You can style the position of the box with username and password with tagsas I did and color them if you want also using tags$style

然后，您可以进一步查看实际页面，并指定由于不同用户而应创建的内容.您还可以查看 JavaScript弹出框

You can then further look into the actual page and specify what should be created as a result of different users. You can also look into JavaScript Popup Boxes

编辑2018:还在此处查看示例

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))

这篇关于输入密码后启动Shiny应用程序的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！