在R中检查URL是否存在

Question

在R中检查URL是否存在

7

我想循环遍历一组URL，查找这些URL是否存在。RCurl提供了"url.exists()"函数。但是输出结果似乎不正确，例如amazon.com显示未注册(因为"url.exists()"函数没有返回200范围内的值，在亚马逊公司的情况下是405（"方法不允许"）)。我还尝试了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()，但据我所知，只有在数据框本身出现问题时才能帮助。

- J. Doe

4个回答

13

这是一个简单的解决方案，可用于解决问题。

urls <-   c("http://www.amazon.com",
            "http://this.isafakelink.biz",
            "https://stackoverflow.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)

- Schwarz

使用 HEAD 方法可能是连接网站的更快速方式。 - leoluyi

4

尝试使用pingr包中的ping函数，它提供ping的时序。

library(pingr)

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

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

- G. Grothendieck

谢谢，但是使用 ping() 我只得到任何站点的 NAs。即使是 ping("amazon.com")。根据 pingr 文档，这个可以正常工作：ping_port("www.google.com", port = 80, count = 1)。我稍后会再次尝试 ping()。 - J. Doe

ICMP 在你的网络中很可能被（理所当然地）阻止了。 - hrbrmstr

0

这里有一个函数，它评估一个表达式并返回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
}

- Jeff Bezos

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- hrbrmstr · Accepted Answer

pingr::ping() 只使用被合理组织网络封锁的ICMP，因为攻击者曾经利用ICMP来窃取数据并与命令和控制服务器通信。

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

当只有非200:299范围的HTTP状态代码时，您应该澄清希望发生什么。以下是一种假设。

注意：您以亚马逊作为例子，我希望那只是您脑海中首先想到的网站，因为爬取亚马逊是不道德的，也是犯罪的。如果您实际上只是一个厚颜无耻的内容盗窃者，请不要将我的代码引入您的世界。如果您正在窃取内容，则不太可能在这里诚实地表达自己，但外部机会是您同时在窃取和有良心，请告诉我，以便我可以删除此答案，以免其他内容窃贼使用它。

这里是一个自包含的检查URL函数：

#' @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