给 Shiny 应用加上登录和注册功能-wutao-blog

目标：

用户进入 Shiny 界面最开始只能看到登录（login）以及注册（register）界面
只有教育邮箱可以直接注册，其他邮箱需要给 Shiny 应用管理者发邮件申请
使用注册的账户登录之后才可以看到可以使用的 Shiny 应用功能
允许用户修改邮箱和充值密码

目前常用的权限管理的包有 shinyauthr 和 shinymanager ，但是这两个都只能直接登录，没有提供注册功能。shiny.reglog 包可以做到这一点，但是实际使用发现在注册阶段，用户只需要提供用户名，密码，邮箱就可以注册，虽然这个包声称会给用户邮箱发送“确认”邮件，但是这个邮件实际上不需要用户确认，随便提供一个邮箱都行。随后在该包的 Github 仓库的 issue （github.com/StatisMike/sh...）中发现了一个解决方法：

按照这个提问者的解决方法，修改了 shiny.reglog 的部分代码，并使其可以支持上面的第二个目标（修改了 utils.R 中的 check_user_mail 函数），修改后的包存放在我的 Github 仓库中：wt12318/shiny.reglog，用户可以使用 devtools 进行安装：

devtools::install_github("wt12318/shiny.reglog")

修改后的注册行为：用户需要提供一个用户名和邮箱，然后会收到一个邮件里面含有随机生成的密码，用户可以使用这个随机生成的密码登录 Shiny 应用，然后再修改自己的密码，修改密码时会让用户提供注册时使用的用户名，然后用户会接收到一个验证码，填入这个验证码就可以修改自己的密码了，之后就可以使用修改后的密码和用户名进行登录。

这个包有三个关键组件构成：

dbConnector： 储存用户信息，包括用户名，邮箱和加密的密码，可以使用 Googlesheet 或者 SQL 数据库，对应的方法为 RegLogGsheetConnector 和 RegLogDBIConnector
mailConnector： 自动给用户发邮件，可以使用 emayili 或者 gmailr包来实现，对应的方法为 RegLogEmayiliConnector 和 RegLogGmailrConnector
RegLogServer: 主要的控制部分，产生 UI ，响应注册和登录系统

创建数据库

为了方便起见，这里使用 DBI 包来创建 SQL 数据库来存放用户信息，支持 SQLite, MySQL, MariaDB 和 PostgreSQL 数据库，我选用的是 SQLite 数据库：

###添加个示例用户
credentials <- data.frame(
  username = "test",
  password = "123",
  email = "shinyreglog@test")

##创建个数据库
conn <- DBI::dbConnect(
  RSQLite::SQLite(),
  dbname = "reglog_db.sqlite"
)

###将上面的示例添加进数据库
DBI_tables_create(
  conn = conn,
  user_data = credentials,
  hash_passwords = T)

##断开
DBI::dbDisconnect(conn)

在 server 部分需要使用 RegLogDBIConnector 来连接这个数据库：

server <- function(input, output, session) {
  
  dbConnector <- RegLogDBIConnector$new(
    driver = RSQLite::SQLite(),
    dbname = "reglog_db.sqlite")
  
}

设置自动发送邮件

这里使用的是 emayili 包，需要提前安装：

install.packages("emayili")

如果想要自动发送邮件，需要我们有一个开通了 SMTP 功能的邮箱，这里以 QQ 邮箱为例，进入 QQ 邮箱的设置-账号：

然后开启 SMTP 服务，并获取授权码：

测试下是否可以发邮件：

library(emayili)
smtp <- emayili::server(
  host = "smtp.qq.com",
  port = 465,
  username = "上面的邮箱地址",
  password = "上面得到的 SMTP 授权码"
)
msg <- envelope() %>%
  from("上面的邮箱地址") %>%
  to("想要接收邮件的邮箱地址")
smtp(msg, verbose = TRUE)

如果运行了上述代码，收到了一个提供的邮箱发来的空的邮件，那就说明可以正常运行。

在 server 部分需要使用 RegLogEmayiliConnector 来设置自动发送邮件：

server <- function(input, output, session) {
  
  mailConnector <- RegLogEmayiliConnector$new(
    from = "email@sending.com",
    smtp = emayili::server(
  			host = "smtp.qq.com",
 			port = 465,
  			username = "上面的邮箱地址",
  			password = "上面得到的 SMTP 授权码"
			)
  )
}

接着就可以使用 RegLogServer 来合并上面两个部分构成注册登录系统的主要构件：

server <- function(input, output, session) {
  
  RegLog <- RegLogServer$new(
    dbConnector = dbConnector,
    mailConnector = mailConnector
  )
}

RegLogServer 有两个必要参数，就是上面的 dbConnector 和 mailConnector，还有一些其他的参数，包括：

app_name，Shiny 应用的名称，将在发送给用户的电子邮件中使用。如果未指定则使用包含应用程序文件的文件夹的名称
app_address，Shiny 应用的 URL 地址，将在发送给用户的电子邮件中使用
lang，在 UI 和邮件中使用的语言，默认是 en（英文）

这个包中包含几个函数来生成预定义的 UI，包括：

RegLog_login_UI()，登录 UI
RegLog_register_UI()，注册 UI
RegLog_credsEdit_UI()，修改用户信息 UI
RegLog_resetPass_UI()，重置密码 UI

现在基于开始的目标构建一个 Demo 应用：

library(shinydashboard)
library(emayili)
library(shiny.reglog)
library(ggpubr)
##生成数据库，下面代码需要在启动 shiny 前提前运行
# credentials <- data.frame(
#   username = "ShinyReglogTest",
#   password = "VeryHardPassword",
#   email = "shinyreglog@test")
# conn <- DBI::dbConnect(
#   RSQLite::SQLite(),
#   dbname = "reglog_db.sqlite"
# )
# DBI_tables_create(
#   conn = conn,
#   use_log = TRUE,
#   user_data = credentials,
#   hash_passwords = T)
# DBI::dbDisconnect(conn)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard",
                  tags$li(class = "dropdown", uiOutput("log_out"))),

  dashboardSidebar(
    collapsed = FALSE, 
    sidebarMenu(
      sidebarMenuOutput("menu")
    )
  ),
  dashboardBody(
  
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",
              fluidRow(
                box(plotOutput("plot1", height = 250)),
                box(
                  title = "Controls",
                  sliderInput("slider", "Number of observations:", 1, 100, 50)
                )
              )
      ),

      tabItem(tabName = "login",
              RegLog_login_UI()
      ),
      tabItem(tabName = "reg",
              RegLog_register_UI()
      ),
      tabItem(tabName = "change",
              RegLog_credsEdit_UI()
      ),
      tabItem(tabName = "reset",
              RegLog_resetPass_UI()
      )
    )
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    dt <- data.frame(his = histdata)
    gghistogram(data=dt,x="his")
  })
  
  dbConnector <- RegLogDBIConnector$new(
    driver = RSQLite::SQLite(),
    dbname = "reglog_db_test.sqlite")
  
  mailConnector <- RegLogEmayiliConnector$new(
    from = "邮箱",
    # to learn how to setup emayili smtp server read ?emayili::server
    smtp = emayili::server(
      host = "smtp.qq.com",
      port = 465,
      username = "邮箱",
      password = "授权码"
    )
  )
  
  RegLog <- RegLogServer$new(
    # both of these elements need to be defined firstly or in this call
    dbConnector = dbConnector,
    mailConnector = mailConnector,
    app_name = "CARToner",
    app_address = "http://cart-fitness.slst.shanghaitech.edu.cn/CAR-fitness/"
  )
  
  output$menu <- renderMenu({
    ##用户登录前只能看见登录和注册页面，登录后可以看见功能页面和修改密码页面
    if(shiny::isTruthy(RegLog$is_logged())){
      sidebarMenu(
        menuItem("Dashboard", tabName = "dashboard",icon = icon("angle-right")),
        menuItem("Edit Credentials", tabName = "change", icon = icon("pen-to-square")),
        menuItem("Reset password", tabName = "reset", icon = icon("window-restore"))
      )
    }else{
      sidebarMenu(
        menuItem("Login", tabName = "login", icon = icon("right-to-bracket")),
        menuItem("Register", tabName = "reg", icon = icon("user-plus"))
      )
    }
  })
}

shinyApp(ui, server)

‍

目录CONTENT

给 Shiny 应用加上登录和注册功能

创建数据库

设置自动发送邮件

评论区