首页 > 解决方案 > 正在运行的 R Shiny 应用程序出现问题:来自 https url 的网络抓取在 RStudio 中有效,但在部署到 shinyapps.io 时不再有效

问题描述

我编写了一个闪亮的应用程序,它可以从中读取数据https://green2.kingcounty.gov/lake-buoy/DataScrape.aspx,工作了几个月,但大约一个月前,它在shinyapps.io停止工作。

我在这里发现了一篇最近的帖子,表明问题是由于最近过期的 SSL 证书造成的。该网站green2.kingcounty.gov确实有一个在 2020 年 5 月 30 日过期的证书

x <- openssl::download_ssl_cert("green2.kincounty.gov")
lapply(x, `[[`, "validity")

然而,正如 weizhang 在上面提到的最近的帖子中所指出的,scrape(在这种情况下使用 GET)在 RStudio 本地工作,但在shinyapps.io上的部署版本中不工作。我的代码的shinyapps.io日志包含一个警告,然后是一个错误:

2020-07-17T16:09:23.073301+00:00 shinyapps[2571330]: Warning: Error in open.connection: SSL certificate problem: certificate has expired
2020-07-17T16:09:23.077027+00:00 shinyapps[2571330]:   68: open.connection
2020-07-17T16:09:23.077213+00:00 shinyapps[2571330]: Error in open.connection(x, "rb") : 
2020-07-17T16:09:23.077028+00:00 shinyapps[2571330]:   66: read_xml.connection
2020-07-17T16:09:23.077214+00:00 shinyapps[2571330]:   SSL certificate problem: certificate has expired
2020-07-17T16:09:23.077029+00:00 shinyapps[2571330]:   65: read_xml.character
2020-07-17T16:09:23.077029+00:00 shinyapps[2571330]:   61: read_html.default
2020-07-17T16:09:23.077030+00:00 shinyapps[2571330]:   59: server [/srv/connect/apps/shiny_test/app.R#25]

看起来community.rstudio.com自 6 月 4 日以来的讨论一直处于休眠状态。我希望我能在这里找到解决此问题的方法。

下面提供了我的应用程序的简单版本。

library(shiny)
library(tidyverse)
library(lubridate)
library(rvest)

# Define UI for application that gets data and creates a plot
ui <- fluidPage(

    # Application title
    titlePanel("Large Lakes Profile Plots"),

        # Show a plot of the data
        mainPanel(
           plotOutput("lakePlot")
        )
    )
# )

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    mnths <- c("January","February","March","April","May","June","July","August","September","October","November","December")
    
    url <- paste("https://green2.kingcounty.gov/lake-buoy/DataScrape.aspx?type=profile&buoy=wa&year=2020&month=6")
    webpage <- read_html(url)
    tbls_ls <- webpage %>%
        html_nodes("table") %>%
        .[1:1] %>%
        html_table(fill = TRUE)
    data <- as.data.frame(tbls_ls)
    
    data$DateTime <- as.POSIXct(data$Date, format="%m/%d/%Y %H:%M:%S %p")
    data$Date <- as.Date(data$DateTime)
    data$Locator <- "Washington"
    data <- data %>% rename(Depth="Depth..m.",Temperature="Temperature...C.",
                                Conductance="Specific.Conductance..µS.cm.",`Dissolved Oxygen`="DO.Concentration..mg.l.",
                                `DO Saturation`="DO.Saturation....",`Chlorophyll, Field`="Chlorophyll..µg.l.",
                                Turbidity="Turbidity..NTU.",`Phycocyanin, Field`="Phycocyanin..µg.l.")
    nms <- names(data)
    data <- data %>% gather(nms[3:10],key="ParmDisplayName",value="Value")

    output$lakePlot <- renderPlot({

        xlabel <- "Temperature"
        tmp <- data %>% filter(ParmDisplayName==xlabel)
        title <- paste(tmp$Locator[1],xlabel,"in",mnths[as.numeric(month(tmp$Date[1]))],year(tmp$Date[1]),sep=" ")
        mrged2 <- tmp[1:days_in_month(as.numeric(month(tmp$Date[1]))),]
        mrged2$Date <- seq(as.Date(paste(year(tmp$Date[1]),month(tmp$Date[1]),1,sep="-")), as.Date(paste(year(tmp$Date[1]),month(tmp$Date[1]),days_in_month(as.numeric(month(tmp$Date[1]))),sep="-")), by = "days")
        mrged2$Depth <- NA
        mrged2$Value <- NA
        #  
        tmp <- rbind(tmp,mrged2)
        # 
        ggplot(tmp, aes(x=Value,y=Depth,color=Locator)) +
            geom_point() +  scale_y_reverse() + facet_wrap(~Date) +
            xlim(0,30) + xlab("") +
            ggtitle(title) 
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

标签: xmlshinyrvestshinyapps

解决方案


我在此页面上搜索同一问题的解决方案时有点奇怪,同时还试图抓取金县的信息。我会继续寻找,如果我发现有用的东西会回帖。


推荐阅读