因為要保護即將推向公眾的 Hazalyst 平台原型,討論後決定要以簡易的密碼機制暫時保護住。至於申請帳號相關的驗證,例如:反機器人、使用信箱註冊、驗證信等,將於下篇文章介紹。這篇文章首先簡單介紹怎麼樣為 R Shiny Server 開放版加上登入功能。

整體架構

這是整體架構。上面是註冊區,通過驗證的帳號、密碼將被加密(目前是取 MD5)然後加入 userpasswd 這個資料庫內。而下方登入區,則是把使用者輸入的帳密在使用者端瀏覽器加密後,在行傳送。因為 R 的登入其實是以 session 來考慮;只要分頁一關掉,連線即結束,下次要重新輸入帳密。

一大抄

程式主體來自於底下兩篇文章:

  1. Authentication of Shiny-server Application Using a Simple Method
  2. Encrypt user’s password with md5 for you Shiny-app

主結構體

Logged = FALSE
PASSWORD <- data.frame(Brukernavn = "withr", Passord = "25d55ad283aa400af464c76d713c07ad")
shinyServer(function(input, output) {
  source("www/Login.R",  local = TRUE)
  
  observe({
    if (USER$Logged == TRUE) {
      # 當密碼正確時才開始運作
      output$obs <- renderUI({...})
    }
  })
})

一開始的 server.R 內的全域變數 Logged 設為沒有登入 FALSE。經過 www/Login.R 這個解碼程式處理,若帳密正確則顯示內容(if 那一大段落)否則繼續保持未登入畫面(此畫面寫死於 Login.R)。

這邊的 PASSWORD 將會被改造成從帳密 SQL database (或檔案?)中讀取。

介面

shinyUI(bootstrapPage(
  # 加入兩 js 檔案及 style.css
  tagList(
    tags$head(
      tags$link(rel="stylesheet", type="text/css",href="style.css"),
      tags$script(type="text/javascript", src = "md5.js"),
      tags$script(type="text/javascript", src = "passwdInputBinding.js")
    )
  ),
  ## 登入畫面
  div(class = "login",
      uiOutput("uiLogin"),
      textOutput("pass")
  ), 
  ## 顯示模組;在 Shiny Server 密碼正確後開始 renderUI 以前是看不到的
  div(...) 
))

Shiny Server 有個特別的功能,就是能在 ui.R 中預留一塊空位,而這塊空位具體顯示的元件則由 server.R 來決定。這邊採用的就是這種模式。如果登入完畢則拉掉登入區域,否則持續顯示。

解碼程式 Login.R

USER <- reactiveValues(Logged = Logged)
passwdInput <- function(inputId, label) {
  tagList(
    tags$label(label),
    tags$input(id = inputId, type="password", value="")
  )
}

取得 ui.R 中的密碼。

output$uiLogin <- renderUI({...})

這一段 renderUI 的目的是密碼打錯了的話重新顯示帳號密碼輸入畫面。

output$pass <- renderText({  
  if (USER$Logged == FALSE) {
    if (!is.null(input$Login)) {
   if (input$Login > 0) {
      Username <- isolate(input$userName)                      # 1
      Password <- isolate(input$passwd)                        # 1
      Id.username <- which(PASSWORD$Brukernavn == Username)    # 2
      Id.password <- which(PASSWORD$Passord    == Password)    # 2
      if (length(Id.username) > 0 & length(Id.password) > 0) { # 3
        if (Id.username == Id.password) {
          USER$Logged <- TRUE
        } 
      } else  {
        "User name or password failed!"
      }
    } 
    }
  }
})

共分成三個部分,這段也是我最困惑的。底下號碼代表我標記的註解

  1. 停止在被 ui.R 或其他網頁端的東西影響?(isolate 函數)
  2. 這邊只是確定是否一樣?(which 函數是用來濃縮列表:只返回 list / vector 中為 TRUE 的項目)如果相同,返回為 TRUE 的元素在原資料結構的位置列表
  3. 相同?只是要比較是否相同,用了奇怪的方式…也許有甚麼我沒參透的點。

客戶端部分

根據原文,作者的這兩份 js 檔個別完成了

  1. Includes md5.js to the head part of ui.R
  2. Create and includes a new ShinyBinding passwdInputBinding to receive the encrypted password.

這兩個檔案隨著 ui.R 啟動被送往瀏覽器端。

影片示例