Verify that either site is contactable

[adamhsparks]

This code sample is from the GSODR package (provided by Bob Rudis on SO). It attempts to download the requested files six times, if it fails, it stops and tells the user that the server is under load.

In this case the FTP server may stop responding to requests if you request too many files too quickly. This could be useful as a starting point after using identical(http_status(GET(url)), 200L) to see if the server is responding, to handle situations where the server is still responding and wouldn't fail with the first check, but won't provide any files because it's too slow to respond.

      # Wrapping the disk writer (for the actual files)
      # Note the use of the cache dir. It won't waste your bandwidth or the
      # server's bandwidth or CPU if the file has already been retrieved.
      s_curl_fetch_disk <- purrr::safely(curl::curl_fetch_disk)
      retry_cfd <-
        function(url, path) {
          cache_file <- sprintf("%s/%s", cache_dir, basename(url))
          if (file.exists(cache_file))
            return()
          i <- 0
          repeat {
            i <- i + 1
            if (i == 6) {
              stop("Too many retries...server may be under load")
            }
            res <- s_curl_fetch_disk(url, cache_file)
            if (!is.null(res$result))
              return()
          }
        }
      message("\nDownloading individual station files.\n")
      pb <- dplyr::progress_estimated(length(years))
      purrr::walk(years, function(yr) {
        year_url <- sprintf(ftp_base, yr)
        tmp <- retry_cfm(year_url, handle = dir_list_handle)
        con <- rawConnection(tmp$content)
        fils <- readLines(con)
        close(con)
        # sift out only the target stations
        purrr::map(station, ~ grep(., fils, value = TRUE)) %>%
          purrr::keep(~ length(.) > 0) %>%
          purrr::flatten_chr() -> fils
        # grab the station files
        purrr::walk(paste0(year_url, fils), retry_cfd)
        # progress bar
        pb$tick()$print()
      })
    }