问题描述

最近做了一个自动生成文档的 shinyApp，顺便用 shinyauthr 包做了一个用户登录界面，但是用户只能用给定的用户名和密码登录，没法修改密码。一直想实现用户修改密码的功能，但是不知道为什么，程序总是报错，报错信息如下：

Warning: Error in if: 参数长度为零
  1: runApp

我的代码


##----------------------------------------------------------------------------##

# 配置环境变量
# Sys.setlocale(category = "LC_ALL", locale = "zh_CN.UTF-8")
# Sys.setenv(RSTUDIO_PANDOC = "/usr/bin")
# options(bitmapType = "cairo")

##----------------------------------------------------------------------------##

# 加载相关R包
library(shiny)
library(shinydashboard)
library(shinyauthr)
library(shinyjs)
library(RSQLite)
library(dplyr)

##----------------------------------------------------------------------------##

# 获取配置文件信息

## 读取配置文件
config = dbConnect(SQLite(), "config.sqlite")

## 处理用户组信息
user_group = dbGetQuery(config, "select * from user_group")

## 关闭数据库连接
dbDisconnect(config)

##----------------------------------------------------------------------------##

# 定义前端交互界面
ui = dashboardPage(
  
  skin = "blue",
  dashboardHeader(
    title = "用户修改密码测试", 
    titleWidth = 260,
    tags$li(
      class = "dropdown", 
      style = "padding: 8px;", 
      logoutUI(
        id = "logout", 
        label = "",
        icon = icon("sign-out-alt"),
        class = "btn-primary",
        style = "color: red;"
      )
    )
  ),
  dashboardSidebar(
    width = 260,
    collapsed = TRUE,
    sidebarMenuOutput("sidebar")
  ),
  dashboardBody(
    useShinyjs(),
    loginUI(
      id = "login",
      title = "用户登录",
      user_title = "用户名",
      pass_title = "用户密码",
      login_title = "登录",
      error_message = "无效的用户名或密码!",
      additional_ui = NULL,
      cookie_expiry = 7
    ),
    tabItems(
      tabItem(
        tabName = "resetpassword",
        uiOutput("resetpassword_ui")
      )
    )
  )

)

##----------------------------------------------------------------------------##

# 定义后台服务逻辑
server = function(input, output, session) {
  
  # 定义凭证信息
  credentials <- loginServer(
    id = "login",
    data = user_group,
    user_col = user,
    pwd_col = password,
    log_out = reactive(logout_init())
  )
  
  logout_init <- logoutServer(
    id = "logout",
    active = reactive(credentials()$user_auth)
  )
  
  # 捕获登录用户信息
  user_info <- reactive({credentials()$info})
  
  # 登录后打开、退出时关闭侧边栏
  observe({
    if(credentials()$user_auth) {
      removeClass(
        selector = "body", 
        class = "sidebar-collapse")
    } else {
      addClass(
        selector = "body", 
        class = "sidebar-collapse")
    }
  })
  
  # 验证通过后才显示侧边菜单栏
  output$sidebar <- renderMenu({
    req(credentials()$user_auth)
    sidebarMenu(
      id = "tabs",
      menuItem(
        "重置密码",
        tabName = "resetpassword",
        icon = icon("key")
      )
    )
  })
  
  output$resetpassword_ui <- renderUI({
    req(credentials()$user_auth)
    fluidPage(
      br(),
      br(),
      column(
        width = 3,
        passwordInput(
          inputId = "password1",
          label = "请输入原密码:",
          value = ""
        ),
        passwordInput(
          inputId = "psssword2",
          label = "请输入新密码:",
          value = ""
        ),
        passwordInput(
          inputId = "password3",
          label = "请确认新密码:",
          value = ""
        ),
        br(),
        actionButton(
          inputId = "button9", 
          label = "提交", 
          icon = icon("check"), 
          width = "300px", 
          class = "btn-primary btn-md"
        ),
        tableOutput("resetpass")
      )
    )
  })
  
  ##--------------------------------------------------------------------------##
  
  # 重置密码
  observeEvent(input$button9, {
    pass1 = input$password1
    pass2 = input$password2
    pass3 = input$password3
    if (pass1 == user_info()$password & pass2 == pass3) {
      ## 修改内存中的user_group表
      user_group$password[user_group$user == user_info()$user] = pass2
      ## 链接配置文件数据库
      config = dbConnect(SQLite(), "config.sqlite")
      ## 修改后的表覆盖原表
      dbWriteTable(
        conn = config,
        name = "user_group",
        value = user_group,
        overwrite = TRUE
      )
      ## 关闭数据库连接
      dbDisconnect(config)
    }
    ## 反馈修改结果
    output$resetpass <- renderTable(
      {
        if (pass1 != user_info()$password) {
          print("输入的原密码和登录密码不一致！")
        }
        if (pass2 != pass3) {
          print("前后两次输入的新密码不一致！")
        }
        if (pass1 == user_info()$password & pass2 == pass3) {
          print("密码已修改成功！")
        }
      }, colnames = FALSE
    )
  })

}

##----------------------------------------------------------------------------##

# 运行shinyApp
shinyApp(ui = ui, server = server)

##----------------------------------------------------------------------------##

其中，初始密码是放在 config.sqlite 数据库的（其实一开始是放在 .csv 文件的，因为有多个配置文件，不方便导入导出），可以用如下代码生成：

library(RSQLite)
user_group = data.frame(
  user = c("admin", "test"),
  password = c("admin", "666666"),
  permissions = c("admin", "standard"),
  name = c("admin", "test")
)
config = dbConnect(SQLite(), "config.sqlite")
dbWriteTable(
  conn = config,
  name = "user_group",
  value = user_group,
  overwrite = TRUE
)
dbDisconnect(config)

系统环境

xfun::session_info(c("shiny", "shinydashboard", "shinyauthr", 
    "shinyjs", "RSQLite"))
#> R version 4.2.2 Patched (2022-11-10 r83330)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 20.04.5 LTS
#> 
#> Locale:
#>   LC_CTYPE=zh_CN.UTF-8       LC_NUMERIC=C              
#>   LC_TIME=zh_CN.UTF-8        LC_COLLATE=zh_CN.UTF-8    
#>   LC_MONETARY=zh_CN.UTF-8    LC_MESSAGES=zh_CN.UTF-8   
#>   LC_PAPER=zh_CN.UTF-8       LC_NAME=C                 
#>   LC_ADDRESS=C               LC_TELEPHONE=C            
#>   LC_MEASUREMENT=zh_CN.UTF-8 LC_IDENTIFICATION=C       
#> 
#> Package version:
#>   base64enc_0.1.3      bit_4.0.5            bit64_4.0.5         
#>   blob_1.2.3           bslib_0.4.2          cachem_1.0.6        
#>   cli_3.6.0            commonmark_1.8.1     crayon_1.5.2        
#>   DBI_1.1.3            digest_0.6.31        dplyr_1.1.0         
#>   ellipsis_0.3.2       fansi_1.0.4          fastmap_1.1.0       
#>   fontawesome_0.5.0    fs_1.6.1             generics_0.1.3      
#>   glue_1.6.2           graphics_4.2.2       grDevices_4.2.2     
#>   htmltools_0.5.4      httpuv_1.6.8         jquerylib_0.1.4     
#>   jsonlite_1.8.4       later_1.3.0          lifecycle_1.0.3     
#>   magrittr_2.0.3       memoise_2.0.1        methods_4.2.2       
#>   mime_0.12            pillar_1.8.1         pkgconfig_2.0.3     
#>   plogr_0.2.0          promises_1.2.0.1     R6_2.5.1            
#>   rappdirs_0.3.3       Rcpp_1.0.10          rlang_1.0.6         
#>   RSQLite_2.2.20       sass_0.4.5           shiny_1.7.4         
#>   shinyauthr_1.0.0     shinydashboard_0.7.2 shinyjs_2.1.0       
#>   sodium_1.2.1         sourcetools_0.1.7.1  stats_4.2.2         
#>   tibble_3.1.8         tidyselect_1.2.0     tools_4.2.2         
#>   utf8_1.2.3           utils_4.2.2          vctrs_0.5.2         
#>   withr_2.5.0          xtable_1.8.4

<sup>Created on 2023-03-01 with reprex v2.0.2</sup>