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

查看:29
本文介绍了输入密码后启动 Shiny 应用程序的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我知道 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 resources:

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

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

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

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆