diff --git a/DESCRIPTION b/DESCRIPTION index 927ab53..f108e60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,14 +41,14 @@ Description: Allows automating the creation of time series of rasters derived Busetto and Ranghetti (2016) . License: GPL-3 Depends: - R (>= 3.5.0) + R (>= 4.2.0) Imports: assertthat, bitops (>= 1.0-6), data.table (>= 1.9.6), gdalUtilities, geojsonio, - httr (>= 1.4.2), + httr2, jsonlite, parallel, raster (>= 3.3.13), diff --git a/NEWS.md b/NEWS.md index 7123749..44471ba 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,12 @@ +# MODIStsp 2.1.1 + +## Major changes +- Major product update: Fix broken authentication to NASA Earthdata sites. +- Migrate to httr2 package and remove dependencies to obsolete httr package + +## Minor changes +- Change maintainer's email in order to follow CRAN requirements. + # MODIStsp 2.1.0 ## Major changes diff --git a/R/MODIStsp-package.R b/R/MODIStsp-package.R index 25cb611..9ac0837 100644 --- a/R/MODIStsp-package.R +++ b/R/MODIStsp-package.R @@ -21,6 +21,7 @@ #' @name MODIStsp-package #' @author Lorenzo Busetto, phD (2014-2017) #' @author Luigi Ranghetti, phD (2015-2017) +#' @author Pasi Autio (2024) #' @seealso [https://docs.ropensci.org/MODIStsp/](https://docs.ropensci.org/MODIStsp/) #' @seealso [https://github.com/ropensci/MODIStsp](https://github.com/ropensci/MODIStsp) #' diff --git a/R/MODIStsp_download.R b/R/MODIStsp_download.R index ce78705..c2e9b32 100644 --- a/R/MODIStsp_download.R +++ b/R/MODIStsp_download.R @@ -24,9 +24,7 @@ #' @param verbose `logical` If FALSE, suppress processing messages, Default: TRUE #' @return The function is called for its side effects #' @rdname MODIStsp_download -#' @author Lorenzo Busetto, phD (2014-2017) -#' @author Luigi Ranghetti, phD (2015) -#' @importFrom httr RETRY authenticate content GET write_disk +#' @importFrom httr2 request req_perform req_auth_bearer_token req_headers resp_body_xml #' @importFrom xml2 as_list MODIStsp_download <- function(modislist, @@ -45,6 +43,13 @@ MODIStsp_download <- function(modislist, gui, verbose) { + # Fetch Bearer token to be used for further authentication + if (exists("earthdata_token")) { + token <- earthdata_token + } else { + token <- get_earthdata_token(user, password) + } + # Cycle on the different files to download for the current date for (file in seq_along(modislist)) { modisname <- modislist[file] @@ -71,25 +76,20 @@ MODIStsp_download <- function(modislist, if (download_server == "http") { while (success == FALSE) { - size_string <- httr::RETRY("GET", - paste0(remote_filename, ".xml"), - httr::authenticate(user, password, type = "any"), - times = n_retries, - pause_base = 0.1, - pause_cap = 10, - quiet = verbose) + size_req <- httr2::request(paste0(remote_filename, ".xml")) %>% + httr2::req_auth_bearer_token(token) + + size_resp <- httr2::req_perform(size_req) # if user/password are not valid, notify - if (size_string["status_code"] == 401) { - stop("Username and/or password are not valid. Please provide - valid ones!") + if (httr2::resp_status(size_resp) == 401) { + stop("Username and/or password are not valid. Please provide valid ones!") } - if (size_string$status_code == 200) { + if (httr2::resp_status(size_resp) == 200) { remote_filesize <- as.integer( xml2::as_list( - httr::content( - size_string, encoding = "UTF-8"))[["GranuleMetaDataFile"]][["GranuleURMetaData"]][["DataFiles"]][["DataFileContainer"]][["FileSize"]] #nolint + httr2::resp_body_xml(size_resp))[["GranuleMetaDataFile"]][["GranuleURMetaData"]][["DataFiles"]][["DataFileContainer"]][["FileSize"]] #nolint ) success <- TRUE } else { @@ -140,29 +140,28 @@ MODIStsp_download <- function(modislist, download <- try(system(aria_string, intern = Sys.info()["sysname"] == "Windows")) } else { - # http download - httr - download <- try(httr::GET(remote_filename, - httr::authenticate(user, password, type = "any"), - # httr::progress(), - httr::write_disk(local_filename, - overwrite = TRUE))) + # http download - httr2 + download_req <- httr2::request(remote_filename) %>% + httr2::req_auth_bearer_token(token) %>% + httr2::req_retry(max_tries = n_retries, backoff = ~ 10) + + download <- httr2::req_perform(download_req, path = local_filename) } } # Check for errors on download try if (inherits(download, "try-error") | - !is.null(attr(download, "status"))) { + !file.exists(local_filename)) { attempt <- attempt + 1 if (verbose) message("[", date(), "] Download Error - Retrying...") unlink(local_filename) # On download error, delete incomplete files Sys.sleep(1) # sleep for a while.... } else { if (download_server == "http" & use_aria == FALSE) { + download_resp <- httr2::resp_status(download) - if (download$status_code != 200 & - length(httr::content(download, - "text", - encoding = "UTF-8")) == 1) { + if (download_resp != 200 & + file.info(local_filename)$size == 0) { # on error, delete last HDF file (to be sure no incomplete # files are left behind and send message) if (verbose) { diff --git a/R/MODIStsp_process.R b/R/MODIStsp_process.R index 1bac443..f261a9d 100644 --- a/R/MODIStsp_process.R +++ b/R/MODIStsp_process.R @@ -229,6 +229,14 @@ MODIStsp_process <- function(proc_opts, check_aria <- Sys.which("aria2c") if (check_aria == "") use_aria <- FALSE + # __________________________________________________________________________ + # Fetch Bearer token to be used for further authentication + + if (exists("earthdata_token")) { + token <- earthdata_token + } else { + token <- get_earthdata_token(user, password) + } # __________________________________________________________________________ # Start Working. #### diff --git a/R/get_earthdata_token.R b/R/get_earthdata_token.R new file mode 100644 index 0000000..3350317 --- /dev/null +++ b/R/get_earthdata_token.R @@ -0,0 +1,30 @@ +#' @title Get Earthdata Bearer access token function +#' @description Internal function to fetch Earthdata access token +#' @details The function is used to: +#' - Fetch Bearer token if there is one already defined; +#' - Request new token if no token is defined +#' - Update token if the token is expired +#' - Bearer token is used for authentication by other functions +#' @param user `character` Username for Earthdata servers +#' @param password `character` Password for Earthdata servers +#' @return The function is called for its side effects +#' @rdname get_earthdata_token +#' @importFrom httr2 request req_perform req_auth_basic req_headers resp_body_xml req_method + + get_earthdata_token <- function(user, password) { + endpoint = "https://urs.earthdata.nasa.gov/api/users/tokens" + resp <- httr2::request(endpoint) |> httr2::req_auth_basic(user, password) |> httr2::req_perform() + token_one <- httr2::resp_body_json(resp)[[1]] + + # Check if no token available; if not, request one + if(length(token_one) < 1) + { + endpoint = "https://urs.earthdata.nasa.gov/api/users/token" + resp <- httr2::request(endpoint) |> req_method("PUT") |> httr2::req_auth_basic(user, password) |> httr2::req_perform() + } + token_one <- httr2::resp_body_json(resp)[[1]] + access_token <- token_one$access_token + # Return token + access_token + } + diff --git a/R/get_mod_dirs.R b/R/get_mod_dirs.R index 67bfe83..2b3534d 100644 --- a/R/get_mod_dirs.R +++ b/R/get_mod_dirs.R @@ -12,7 +12,7 @@ #' be identified #' @param n_retries `numeric` number of times the access to the http server #' should be retried in case of error before quitting, Default: 20 -#' @param gui `logical`` indicates if processing was called from the GUI +#' @param gui `logical` indicates if processing was called from the GUI #' environment or not. If not, processing messages are sent to a log file #' instead than to the console/GTK progress windows. #' @param out_folder_mod `character` output folder for MODIS HDF storage @@ -25,18 +25,28 @@ #' FTP) by: #' @author Lorenzo Busetto, phD (2014-2017) #' @author Luigi Ranghetti, phD (2016-2017) +#' @author Pasi Autio (2024) #' @note License: GPL 3.0 #' @importFrom stringr str_sub str_split -#' @importFrom httr RETRY authenticate content +#' @importFrom httr2 request req_perform req_auth_bearer_token req_headers resp_body_string req_retry resp_status get_mod_dirs <- function(http, download_server, user, password, yy, - n_retries, + n_retries = 20, gui, out_folder_mod) { + # Fetch Bearer token to be used for further authentication + if (is.null(earthdata_token)) + { + token <- earthdata_token + } else + { + token <- get_earthdata_token(user, password) + } + # make sure that the http address terminates with a "/" (i.e., it is a # folder, not a file) if (stringr::str_sub(http, -1) != "/") { @@ -47,24 +57,16 @@ get_mod_dirs <- function(http, # retrieve list of folders in case of http download #### if (download_server == "http") { - response <- data.frame(status_code = "") + response <- list(status_code = "") while (response$status_code != 200) { # send request to server - response <- try( - httr::RETRY("GET", - http, - httr::authenticate(user, password), - times = n_retries, - pause_base = 0.1, - pause_cap = 3, - quiet = FALSE), - silent = TRUE - ) + req <- httr2::request(http) %>% + httr2::req_auth_bearer_token(token) %>% + httr2::req_retry(max_tries = n_retries, backoff = ~ 10) + response <- httr2::req_perform(req) - # On interactive execution, after n_retries attempt ask if quit or ---- - # retry - - if (inherits(response, "try-error") || response$status_code != 200) { + # On interactive execution, after n_retries attempt ask if quit or retry + if (inherits(response, "try-error") || httr2::resp_status(response) != 200) { message( "[", date(), "] Error: http server seems to be down! ", "Please try again later. Aborting!" @@ -74,9 +76,8 @@ get_mod_dirs <- function(http, return(date_dirs) } } - # On httr success get the directory names (available dates) ---- - items <- strsplit(httr::content(response, "text", encoding = "UTF-8"), - "\r*\n")[[1]] + # On httr2 success get the directory names (available dates) ---- + items <- strsplit(httr2::resp_body_string(response), "\r*\n")[[1]] date_dirs <- gsub( ".*>(20[0-9]{2}\\.[01][0-9]\\.[0-3][0-9])\\/<.*", "\\1", items ) diff --git a/R/get_mod_filenames.R b/R/get_mod_filenames.R index a67d227..912fdc3 100644 --- a/R/get_mod_filenames.R +++ b/R/get_mod_filenames.R @@ -29,8 +29,9 @@ #' FTP) by: #' @author Lorenzo Busetto, phD (2014-2016) #' @author Luigi Ranghetti, phD (2016) +#' @author Pasi Autio (2024) #' @note License: GPL 3.0 -#' @importFrom httr RETRY authenticate content +#' @importFrom httr2 request req_perform req_auth_bearer_token req_headers resp_body_xml req_retry resp_body_string #' @importFrom stringr str_split str_pad get_mod_filenames <- function(http, used_server, @@ -44,7 +45,15 @@ get_mod_filenames <- function(http, out_folder_mod, gui) { - + # Fetch Bearer token to be used for further authentication + if (is.null(earthdata_token)) + { + token <- earthdata_token + } else + { + token <- get_earthdata_token(user, password) + } + success <- FALSE if (used_server == "http") { # ________________________________________________________________________ @@ -53,13 +62,12 @@ get_mod_filenames <- function(http, # http folders are organized by date subfolders containing all tiles while (!success) { - response <- httr::RETRY("GET", - paste0(http, date_dir, "/"), - httr::authenticate(user, password), - times = n_retries, - pause_base = 0.1, - pause_cap = 10, - quiet = FALSE) + # Create a request object using httr2 + req <- httr2::request(paste0(http, date_dir, "/")) %>% + httr2::req_auth_bearer_token(token) %>% + httr2::req_retry(max_tries = n_retries, backoff = ~ 10) + + response <- httr2::req_perform(req) # On interactive execution, after n_retries attempt ask if quit or ---- # retry @@ -68,8 +76,8 @@ get_mod_filenames <- function(http, "Please try again later. Aborting!", call. = FALSE) } else { - getlist <- strsplit(httr::content(response, "text", encoding = "UTF-8"), - "\r*\n")[[1]] + content <- httr2::resp_body_string(response) + getlist <- strsplit(content, "\r*\n")[[1]] getlist <- getlist[grep( ".*>([A-Z0-9]+\\.A[0-9]+(?:\\.h[0-9]{2}v[0-9]{2})?\\.[0-9]+\\.[0-9]+\\.hdf)<.*", #nolint getlist)] @@ -77,6 +85,7 @@ get_mod_filenames <- function(http, ".*>([A-Z0-9]+\\.A[0-9]+(?:\\.h[0-9]{2}v[0-9]{2})?\\.[0-9]+\\.[0-9]+\\.hdf)<.*", "\\1", #nolint getlist) success <- TRUE + print(getlist) } } @@ -126,5 +135,6 @@ get_mod_filenames <- function(http, } else { Modislist <- grep(".hdf$", getlist, value = TRUE) } + print(Modislist) return(Modislist) } diff --git a/README.Rmd b/README.Rmd index f074a26..c098440 100644 --- a/README.Rmd +++ b/README.Rmd @@ -64,6 +64,9 @@ For more information, documentation and examples of use, __see also the `{MODISt ## Important News +- 13/05/2023 - `{MODIStsp}` (GitHub version 2.1.1) +Update MODIStsp to use httr2 package instead of obsolete httr to access Earthdata site while fixing the authentication issues at the same time. + - 29/10/2021 - `{MODIStsp}` (GitHub version 2.0.6.9000) supports products with version 061. Version 006 will remain the default product version until its decommission will be announced. diff --git a/README.md b/README.md index 2c8486f..d0c1836 100644 --- a/README.md +++ b/README.md @@ -44,7 +44,7 @@ Lorenzo](https://docs.ropensci.org/MODIStsp/articles/lorenzo.html). To cite `{MODIStsp}` please use: -L. Busetto, L. Ranghetti (2016) MODIStsp: An R package for automatic +L. Busetto, L. Ranghetti (2016), P. Autio (2024) MODIStsp: An R package for automatic preprocessing of MODIS Land Products time series, Computers & Geosciences, Volume 97, Pages 40-48, ISSN 0098-3004, , URL: @@ -58,6 +58,12 @@ For more information, documentation and examples of use, **see also the ## Important News +- 14/05/2024 - `{MODIStsp}` 2.2.0 (GitHub version 2.2.0) is out. + This version switches to httr2 package and starts using + Bearer authentication to Earthdata sites. MODIStsp() uses + Earthdata token 1 for the authentication are requests new + token automatically if the old one is expired. + - 29/10/2021 - `{MODIStsp}` (GitHub version 2.0.6.9000) supports products with version 061. Version 006 will remain the default product version until its decommission will be announced. Version @@ -148,7 +154,7 @@ For more information, documentation and examples of use, **see also the ## System Requirements -`{MODIStsp}` requires [`R`](https://cran.r-project.org) v \>= 3.6.3. +`{MODIStsp}` requires [`R`](https://cran.r-project.org) v \>= 4.2.0. ------------------------------------------------------------------------ diff --git a/inst/app/srv/mstp_helpmess_srv.R b/inst/app/srv/mstp_helpmess_srv.R index 2dbe54e..17ee079 100644 --- a/inst/app/srv/mstp_helpmess_srv.R +++ b/inst/app/srv/mstp_helpmess_srv.R @@ -288,7 +288,7 @@ shiny::observeEvent(input$help_downloader, { )), shiny::p(shiny::HTML( "http is the downloader which is used by default", - "through the package 'httr'." + "through the package 'httr2'." )), shiny::p(shiny::HTML( "aria2", diff --git a/vignettes/faq.Rmd b/vignettes/faq.Rmd index 99bcd6e..cff279b 100644 --- a/vignettes/faq.Rmd +++ b/vignettes/faq.Rmd @@ -95,7 +95,7 @@ If you have problems in installing the "devel" version of `devtools`, manually i ``` install.packages(c("bitops", "data.table" , "gdalUtilities", "gWidgets", "gWidgetsRGtk2", - "httr" , "jsonlite", "parallel", "raster", "sf", "stringr", "xts")) + "httr2" , "jsonlite", "parallel", "raster", "sf", "stringr", "xts")) ``` , then continue with standard `MODIStsp` installation. @@ -125,7 +125,7 @@ ________________________________________________________________________________ 1. If you're connecting to the internet **via a proxy**, download will fail. To solve the problem, identify the IP address and port of you proxy, and before running MODIStsp, run the following instructions: ``` - library(httr) + library(httr2) set_config(use_proxy(url="XXX.XXX.XXX.XXX", port=YYYY)) ```