检查 R 中是否存在 URL

Question

我想遍历 URL 的列表，我想知道这些 URL 是否存在。

RCurl 提供了 url.exists() 功能。但是，输出似乎不正确，因为例如它说 amazon.com 没有注册（它这样做是因为 url.exists()-函数没有 return 中的值200 范围，在 amazon.com 的情况下是 405 ("method not allowed")。

我还尝试了 httr 包提供的 HEAD() 和 GET()。但有时我会在这里收到错误消息，例如超时或因为 URL 未注册。

错误消息如下所示：

Error in curl::curl_fetch_memory(url, handle = handle) : Timeout was reached: Connection timed out after 10000 milliseconds

Error in curl::curl_fetch_memory(url, handle = handle) : Could not resolve host: afsadadssadasf.com

当我遇到这样的错误时，整个 for 循环就会停止。是否可以继续 for 循环？我试过 tryCatch()，但据我所知，这只能在数据框本身出现问题时提供帮助。

Answer 1

试试 pingr 包中的 ping 功能。它给出了 ping 的时间。

library(pingr)

ping("amazon.com") # good site
## [1] 45 46 45

ping("xxxyyyzzz.com") # bad site
## [1] NA NA NA

Answer 2

pingr::ping() 仅使用在健全的组织网络上被阻止的 ICMP，因为攻击者使用 ICMP 作为一种方式来泄露数据并与 command-and-control 服务器通信。

pingr::ping_port() 不使用 HTTP Host: header 因此 IP 地址可能正在响应，但目标虚拟 Web 主机可能不在运行上并且它绝对不会验证路径是否存在于目标 URL.

您应该阐明当只有非 200:299 范围的 HTTP 状态代码时您希望发生什么。下面做一个假设。

注意：您以亚马逊为例，我希望这是第一个 "came to mind" 的网站，因为它是不道德的，而且我和亚马逊之间的关系是犯罪如果您实际上只是一个厚颜无耻的内容窃贼，我将不胜感激。如果您在窃取内容，您不太可能会在这里坦诚相待，但如果您在窃取并有良心的话，请告诉我，这样我就可以删除这个答案，这样至少其他内容窃贼可以不要用它。

这里有一个 self-contained 函数用于检查 URLs:

#' @param x a single URL
#' @param non_2xx_return_value what to do if the site exists but the
#'        HTTP status code is not in the `2xx` range. Default is to return `FALSE`.
#' @param quiet if not `FALSE`, then every time the `non_2xx_return_value` condition
#'        arises a warning message will be displayed. Default is `FALSE`.
#' @param ... other params (`timeout()` would be a good one) passed directly
#'        to `httr::HEAD()` and/or `httr::GET()`
url_exists <- function(x, non_2xx_return_value = FALSE, quiet = FALSE,...) {

  suppressPackageStartupMessages({
    require("httr", quietly = FALSE, warn.conflicts = FALSE)
  })

  # you don't need thse two functions if you're alread using `purrr`
  # but `purrr` is a heavyweight compiled pacakge that introduces
  # many other "tidyverse" dependencies and this doesnt.

  capture_error <- function(code, otherwise = NULL, quiet = TRUE) {
    tryCatch(
      list(result = code, error = NULL),
      error = function(e) {
        if (!quiet)
          message("Error: ", e$message)

        list(result = otherwise, error = e)
      },
      interrupt = function(e) {
        stop("Terminated by user", call. = FALSE)
      }
    )
  }

  safely <- function(.f, otherwise = NULL, quiet = TRUE) {
    function(...) capture_error(.f(...), otherwise, quiet)
  }

  sHEAD <- safely(httr::HEAD)
  sGET <- safely(httr::GET)

  # Try HEAD first since it's lightweight
  res <- sHEAD(x, ...)

  if (is.null(res$result) || 
      ((httr::status_code(res$result) %/% 200) != 1)) {

    res <- sGET(x, ...)

    if (is.null(res$result)) return(NA) # or whatever you want to return on "hard" errors

    if (((httr::status_code(res$result) %/% 200) != 1)) {
      if (!quiet) warning(sprintf("Requests for [%s] responded but without an HTTP status code in the 200-299 range", x))
      return(non_2xx_return_value)
    }

    return(TRUE)

  } else {
    return(TRUE)
  }

}

试一试：

c(
  "http://content.thief/",
  "http://rud.is/this/path/does/not_exist",
  "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=content+theft", 
  "https://www.google.com/search?num=100&source=hp&ei=xGzMW5TZK6G8ggegv5_QAw&q=don%27t+be+a+content+thief&btnK=Google+Search&oq=don%27t+be+a+content+thief&gs_l=psy-ab.3...934.6243..7114...2.0..0.134.2747.26j6....2..0....1..gws-wiz.....0..0j35i39j0i131j0i20i264j0i131i20i264j0i22i30j0i22i10i30j33i22i29i30j33i160.mY7wCTYy-v0", 
  "https://rud.is/b/2018/10/10/geojson-version-of-cbc-quebec-ridings-hex-cartograms-with-example-usage-in-r/"
) -> some_urls

data.frame(
  exists = sapply(some_urls, url_exists, USE.NAMES = FALSE),
  some_urls,
  stringsAsFactors = FALSE
) %>% dplyr::tbl_df() %>% print()
##  A tibble: 5 x 2
##   exists some_urls                                                                           
##   <lgl>  <chr>                                                                               
## 1 NA     http://content.thief/                                                               
## 2 FALSE  http://rud.is/this/path/does/not_exist                                              
## 3 TRUE   https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=con…
## 4 TRUE   https://www.google.com/search?num=100&source=hp&ei=xGzMW5TZK6G8ggegv5_QAw&q=don%27t…
## 5 TRUE   https://rud.is/b/2018/10/10/geojson-version-of-cbc-quebec-ridings-hex-cartograms-wi…
## Warning message:
## In FUN(X[[i]], ...) :
##   Requests for [http://rud.is/this/path/does/not_exist] responded but without an HTTP status code in the 200-299 range

Answer 3

这里有一个简单的解决方法。

urls <-   c("http://www.amazon.com",
            "http://this.isafakelink.biz",
            "https://whosebug.com")

valid_url <- function(url_in,t=2){
  con <- url(url_in)
  check <- suppressWarnings(try(open.connection(con,open="rt",timeout=t),silent=T)[1])
  suppressWarnings(try(close.connection(con),silent=T))
  ifelse(is.null(check),TRUE,FALSE)
}

sapply(urls,valid_url)

Answer 4

这是一个计算表达式的函数，returns TRUE 如果有效， FALSE 如果无效。您还可以在表达式内部分配变量。

try_catch <- function(exprs) {!inherits(try(eval(exprs)), "try-error")}

try_catch(out <- log("a")) # returns FALSE
out # Error: object 'out' not found

try_catch(out <- log(1)) # returns TRUE
out # out = 0

您可以使用表达式来检查是否成功。

done <- try_catch({
    # try something
})
if(!done) {
    done <- try_catch({
        # try something else
    })
}
if(!done) {
    # default expression
}

检查 R 中是否存在 URL

Check if URL exists in R

r

url

rcurl

httr