Shiny Server Proにはパスワード制御の機能があることを知っています。質問は、ShinyにはtextInput()のような関数passwordInput()があるということです。誰もが次のことを行う方法について考えています。
1)正しいパスワード入力後にのみアプリケーションを起動する2)正しいパスワード入力後にアプリケーションの一部を起動する(たとえば、shinydashboardにいくつかのタブがあり、そのうちの1つにパスワードのみでアクセスしたい)
ありがとう!
私は#1に答えるつもりです、そして#2についてはあなたは私の例で単純に展開することができます。この例に従ってください Shiny-appのmd5でパスワードを暗号化します 次のことができます:
1)2ページを作成し、ユーザーが正しいユーザー名とパスワードを入力した場合、renderUI
を使用してhtmlOutput
を使用してページを出力できます2)ユーザー名とパスワードでボックスの位置をスタイルできますtags
asと同じように、tags$style
その後、実際のページをさらに調べて、さまざまなユーザーの結果として作成されるものを指定できます。 JavaScriptポップアップボックス を調べることもできます
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))
私は同じ質問をしなければならず、上記の答えにつまずき、実装するのが難しすぎると感じました。どうやら、他の sers on SOがあり、上記のソリューションを実装するための同様の問題がありました。
追加/削除タブとshinyjsを使用して、はるかに簡単な回避策を構築しました。仕組みは次のとおりです。 2つの別個のUI機能を使用したくない場合に役立ちます。
以下に簡単な例を示します。さらに、ユーザー履歴のカウントやログイン試行回数の制限、ユーザーログ、メッセージハンドラーなど、不要な機能をいくつか追加しました。シンプルにするためにこれらの機能をコメントアウトしましたが、興味がある場合はご覧ください。追加の機能はサーバーで実行する必要があることに注意してください。
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