错误:由于会话密钥已更改而无法解密密钥 | 闪亮应用程序.io | 右

pra*_*asi 0 encryption session r shiny

注意:这个(冗长的)问题是我上一篇文章的后续问题。

我想在本地实现数据加密(本地RStudio)并远程解密加密数据(托管在shinyapps.io上的应用程序)

代码的第一部分本质上使用key. 代码的第二部分是一个闪亮的应用程序,它使用相同的数据帧来解密数据帧key,从而在应用程序内使用该数据帧进行身份验证。该代码在我的机器上运行得很好。

但是,当发布到shinyapps.io (基于云的托管服务)时,它会抛出错误,如下所示:

在此输入图像描述

1.用于加密数据帧的代码。

library(sodium)
#> Warning: package 'sodium' was built under R version 3.5.3
library(encryptr)
#> Warning: package 'encryptr' was built under R version 3.5.3
library(cyphr)
#> Warning: package 'cyphr' was built under R version 3.5.3
#> 
#> Attaching package: 'cyphr'
#> The following objects are masked from 'package:encryptr':
#> 
#>     decrypt, decrypt_file, encrypt, encrypt_file

#setting local working directory 
#setwd("D://Work/03Mar20/")

df = data.frame(
  user = c("user1", "user2", "user3", "user4", "user5"),
  password = c("pass1", "pass2", "pass3", "pass4", "pass5"),
  permissions = c("admin","admin","admin","admin","admin"),
  name = c("user one", "user two", "user three", "user four", "user five"),
  stringsAsFactors = FALSE
)

#generating a key and encrypting the desired dataframe using cyphr and sodium packages
key <- cyphr::key_sodium(sodium::keygen())
cyphr::encrypt(saveRDS(df, "auth_base.rds"), key)

#saving the key as a .rds file and removing from R environment
saveRDS(key, "key.rds")
rm(key)


Created on 2020-03-06 by the reprex package (v0.3.0)
Run Code Online (Sandbox Code Playgroud)

2.闪亮应用程序的代码(解密数据帧并授权用户)

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyauthr)
library(shinyjs)
library(sodium)
library(encryptr)
library(cyphr)
library(glue)
library(knitr)
library(rsconnect)
library(ggplot2)
library(DT)

#setting local working directory 
#setwd("D://Work Related/03Mar20")

key <- readRDS("key.rds")
df = cyphr::decrypt(readRDS("auth_base.rds"), key)

#Dataframe that holds usernames, passwords and other user data
credentials = data.frame(
    username = df$user,
    password = sapply(df$password, sodium::password_store),
    permission = df$permissions, 
    name = df$name,
    stringsAsFactors = FALSE
)

# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
                 wellPanel(
                     tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
                     textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
                     passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
                     br(),
                     div(
                         style = "text-align: center;",
                         actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
                                 padding: 10px 15px; width: 150px; cursor: pointer;
                                 font-size: 18px; font-weight: 600;"),
                         shinyjs::hidden(
                             div(id = "nomatch",
                                 tags$p("Incorrect username or password!",
                                        style = "color: red; font-weight: 600; 
                                            padding-top: 5px;font-size:16px;", 
                                        class = "text-center"))),
                         br()
                     ))
)

header <- dashboardHeader( title = "Template", uiOutput("logoutbtn"))
sidebar <- dashboardSidebar(collapsed = FALSE, uiOutput("sidebarpanel")) 
body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body"))

ui<-dashboardPage(header, sidebar, body, skin = "blue")

server <- function(input, output, session) {

    login = FALSE
    USER <- reactiveValues(login = login)

    observe({ 
        if (USER$login == FALSE) {
            if (!is.null(input$login)) {
                if (input$login > 0) {
                    Username <- isolate(input$userName)
                    Password <- isolate(input$passwd)
                    if(length(which(credentials$username==Username))==1) { 
                        pasmatch  <- credentials["password"][which(credentials$username==Username),]
                        pasverify <- password_verify(pasmatch, Password)
                        if(pasverify) {
                            USER$login <- TRUE
                        } else {
                            shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
                            shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
                        }
                    } else {
                        shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
                        shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
                    }
                } 
            }
        }    
    })

    output$logoutbtn <- renderUI({
        req(USER$login)
        tags$li(a(icon("fa fa-sign-out"), "Logout", 
                  href="javascript:window.location.reload(true)"),
                class = "dropdown", 
                style = "background-color: #eee !important; border: 0;
                    font-weight: bold; margin:5px; padding: 10px;")
    })

    output$sidebarpanel <- renderUI({
        if (USER$login == TRUE ){ 
            if (credentials[,"permission"][which(credentials$username==input$userName)]=="admin") {
                sidebarMenu(
                    div(textOutput("permission"), style = "padding: 20px"),
                    menuItem("Data", tabName = "dashboard", icon = icon("table"))
                    )
            }
        }
    })



    output$body <- renderUI({
        if (USER$login == TRUE ) {
            if (credentials[,"permission"][which(credentials$username==input$userName)]=="admin") {
                tabItems(
                    tabItem(
                        tabName ="dashboard", class = "active",
                        fluidRow(
                            box(width = 12, dataTableOutput('results'))
                        ))
                )
            }

        }
        else {
            loginpage
        }
    })

    output$permission <- renderText({
        if (USER$login == TRUE ) {
            paste("Permission: ", credentials[,"permission"][which(credentials$username==input$userName)])
        }    
    })

    output$results <-  DT::renderDataTable({
        datatable(mtcars, options = list(autoWidth = TRUE,
                                         searching = FALSE))
    })

}

shinyApp(ui, server)
Run Code Online (Sandbox Code Playgroud)

我从错误中了解到,key当我将其发布到云进行解密时,加密时的会话 ID 不匹配。作为安全领域的菜鸟,有没有什么变通的办法可以实现云端解密呢?

非常感谢任何建议。

tho*_*hal 7

问题原因

问题是设计使然 ,因为cyphr::key_sodium创建的密钥仅对当前会话有效。也就是说,不可能在不同的会话之间共享它,更不用说不同的系统了。

因此,问题与它本身无关shiny,而是与您尝试cyphr在不同会话中使用密钥这一事实有关。

来自小插图:

当使用 key_openssl、keypair_openssl、key_sodium 或 keypair_sodium 时,我们会生成可以解密数据的东西。这些函数返回的对象可以加密和解密数据,因此有理由担心,如果这些对象本身保存到磁盘,您的数据将受到损害。

为了避免这种情况,cyphr 不会直接在这些对象中存储私钥或对称密钥,而是使用每次加载包时重新生成的 cyphr 特定会话密钥来加密敏感密钥。这意味着这些对象实际上只在一个会话中有用,如果使用 save.image 保存(可能在会话结束时自动保存),则密钥不能用于解密数据。

问题的代表

library(cyphr)

file <- "encr.rds"
df <- data.frame(a = 1) 

## cyphr workflow won't work across sessions / systems

key <- key_sodium(sodium::keygen())

encrypt(saveRDS(df, file), key)

## works within the same session
decrypt(readRDS(file), key)

## simulate session change (restart or other system)
session_key_refresh()

## won't work
decrypt(readRDS(file), key)
unlink(file)
Run Code Online (Sandbox Code Playgroud)

解决方案


笔记。更新了代码,因为不需要保存和存储nonce.


因此,您需要使用不同的库来完成这项工作。例如,您可以使用库sodium本身:

library(cyphr)

file <- "encr.rds"
df <- data.frame(a = 1) 

## cyphr workflow won't work across sessions / systems

key <- key_sodium(sodium::keygen())

encrypt(saveRDS(df, file), key)

## works within the same session
decrypt(readRDS(file), key)

## simulate session change (restart or other system)
session_key_refresh()

## won't work
decrypt(readRDS(file), key)
unlink(file)
Run Code Online (Sandbox Code Playgroud)

您现在可以分享key.rds(或将其放到您闪亮的服务器上)。要模拟这种情况,只需重新启动 R 并运行:

library(sodium)
key_file <- "key.rds"
file <- "encr.rds"
key <- readRDS(key_file)

# Decrypt with same stored key and nonce
decipher <- readRDS(file)
unserialize(data_decrypt(decipher, key))

#   a
# 1 1

unlink(key_file)
unlink(file)
Run Code Online (Sandbox Code Playgroud)

安全问题

使用对称加密(这是一个用于解密/加密的密钥,就像在您的示例中一样)并将密钥存储在服务器顶部听起来不是一个好主意。任何获得您的密钥文件的人都能够解密您的秘密。

我自己不是安全专家,但我会重新考虑你的设计。