Подтвердить что ты не робот

Запуск приложения Shiny после ввода пароля

Я знаю, что в Shiny Server Pro есть функция управления паролями. Вопрос в том, что у Shiny есть функция passwordInput(), которая похожа на textInput() Кто-нибудь думал о том, как сделать следующее:

1) Запуск приложения только после правильного ввода пароля 2) Запуск части приложения после правильного ввода пароля (например, у меня есть несколько вкладок в shinydashboard, и я хочу сделать доступ к одному из них только по паролю)

Спасибо!

4b9b3361

Ответ 1

ОБНОВЛЕНИЕ 2019: Теперь мы можем использовать пакет shinymanager, чтобы сделать это: скрипт invactivity предназначен для тайм-аута страницы входа в систему после 2 минут бездействия, чтобы вы не теряли ресурсы:

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)

enter image description here

Исходное сообщение: Я собираюсь ответить # 1, а для № 2 вы можете просто расширить мой пример. Следуя этому примеру, зашифруйте пароль с помощью md5 для Shiny-app. вы можете сделать следующее:

1) Создайте 2 страницы, и если пользователь вводит правильное имя пользователя и пароль, вы можете renderUI и использовать htmlOutput для вывода вашей страницы. 2) Как и я, вы можете назначить положение поля с именем пользователя и паролем с помощью tags и раскрасить их, если хотите, используя tags$style

Затем вы можете дополнительно просмотреть фактическую страницу и указать, что должно быть создано в результате действий разных пользователей. Вы также можете просмотреть всплывающие окна JavaScript

ОБНОВЛЕНИЕ 2018: Также посмотрите на пример здесь https://shiny.rstudio.com/gallery/authentication-and-database.html

Example of front page

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

Ответ 2

Я должен был задать тот же вопрос, наткнулся на приведенный выше ответ и нашел его слишком сложным для реализации. По-видимому, в SO были другие пользователи с подобными проблемами для реализации вышеуказанного решения.

Я построил намного более простой обходной путь, используя добавление/удаление табуляции и блестящий. Вот как это работает. Это может помочь тем, кто не хочет работать с двумя отдельными функциями пользовательского интерфейса.

  1. Создайте вкладку для входа, в которую пользователи смогут войти. Все остальные вкладки еще не отображаются, а также боковая панель.
  2. После успешного входа: Добавьте вкладки, которые вы действительно хотите показать, удалите вкладку входа в систему (она больше не нужна) и покажите боковую панель с блестящей.

Я приведу простой пример ниже. Кроме того, я добавил некоторые функции, которые не являются необходимыми, такие как подсчет истории пользователя и ограничение количества попыток входа в систему, журнал пользователя и обработчик сообщений и т.д. Я прокомментировал эти функции, чтобы упростить задачу, но если вам интересно, взгляните. Обратите внимание, что дополнительные функции должны быть запущены на сервере.

Единственный недостаток неиспользуемого сервера Pro - это отсутствующее соединение https, которое необходимо добавить с помощью другого обходного пути, если это действительно необходимо.

Я задокументировал простой пример и подход с дополнительными функциями на GitHub. Работающую версию последней можно найти на shinyapps.io.

Ниже я публикую код более простой версии приложения, ориентируясь на сам логин.

Имена пользователей и пароли, необходимые для входа в систему, следующие:

    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