web-dev-qa-db-ja.com

パスワード入力後のShinyアプリの起動

Shiny Server Proにはパスワード制御の機能があることを知っています。質問は、ShinyにはtextInput()のような関数passwordInput()があるということです。誰もが次のことを行う方法について考えています。

1)正しいパスワード入力後にのみアプリケーションを起動する2)正しいパスワード入力後にアプリケーションの一部を起動する(たとえば、shinydashboardにいくつかのタブがあり、そのうちの1つにパスワードのみでアクセスしたい)

ありがとう!

私は#1に答えるつもりです、そして#2についてはあなたは私の例で単純に展開することができます。この例に従ってください Shiny-appのmd5でパスワードを暗号化します 次のことができます:

1)2ページを作成し、ユーザーが正しいユーザー名とパスワードを入力した場合、renderUIを使用してhtmlOutputを使用してページを出力できます2)ユーザー名とパスワードでボックスの位置をスタイルできますtagsasと同じように、tags$style

その後、実際のページをさらに調べて、さまざまなユーザーの結果として作成されるものを指定できます。 JavaScriptポップアップボックス を調べることもできます

EDIT 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))
52
Pork Chop

私は同じ質問をしなければならず、上記の答えにつまずき、実装するのが難しすぎると感じました。どうやら、他の sers on SOがあり、上記のソリューションを実装するための同様の問題がありました。

追加/削除タブとshinyjsを使用して、はるかに簡単な回避策を構築しました。仕組みは次のとおりです。 2つの別個のUI機能を使用したくない場合に役立ちます。

  1. ユーザーがログインできるログインタブを作成します。他のすべてのタブはまだ表示されておらず、サイドバーも表示されていません。
  2. ログインが成功した場合:実際に表示するタブを追加し、ログインタブを削除し(不要になった)、shinyjsでサイドバーを表示します。

以下に簡単な例を示します。さらに、ユーザー履歴のカウントやログイン試行回数の制限、ユーザーログ、メッセージハンドラーなど、不要な機能をいくつか追加しました。シンプルにするためにこれらの機能をコメントアウトしましたが、興味がある場合はご覧ください。追加の機能はサーバーで実行する必要があることに注意してください。

Shiny server 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
0
TimTeaFan