new devel branch

.Rbuildignore

@@ -31,3 +31,4 @@
 ^doc$
 ^Meta$
 ^CRAN-SUBMISSION$
+^MODIStsp\.Rproj$

DESCRIPTION

@@ -41,14 +41,14 @@ Description: Allows automating the creation of time series of rasters derived
     Busetto and Ranghetti (2016) <doi:10.1016/j.cageo.2016.08.020>.
 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),
@@ -90,7 +90,7 @@ URL: https://github.com/ropensci/MODIStsp/, https://docs.ropensci.org/MODIStsp/
 BugReports: https://github.com/ropensci/MODIStsp/issues
 LazyData: true
 VignetteBuilder: knitr
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 Encoding: UTF-8
 Language: en-US

NAMESPACE

@@ -26,11 +26,16 @@ importFrom(gdalUtilities,gdal_translate)
 importFrom(gdalUtilities,gdalbuildvrt)
 importFrom(gdalUtilities,gdalwarp)
 importFrom(gdalUtilities,ogr2ogr)
-importFrom(httr,GET)
-importFrom(httr,RETRY)
-importFrom(httr,authenticate)
-importFrom(httr,content)
-importFrom(httr,write_disk)
+importFrom(httr2,req_auth_basic)
+importFrom(httr2,req_auth_bearer_token)
+importFrom(httr2,req_headers)
+importFrom(httr2,req_method)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_retry)
+importFrom(httr2,request)
+importFrom(httr2,resp_body_string)
+importFrom(httr2,resp_body_xml)
+importFrom(httr2,resp_status)
 importFrom(jsonlite,read_json)
 importFrom(jsonlite,write_json)
 importFrom(parallel,detectCores)

NEWS.md

@@ -2,6 +2,13 @@
 
 - interim mods to record maintainer change (mdsumner), tagged at master branch v2.1.0.9001
 
+## 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

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

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) {

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
+ ## this exist of earthdata_token can't work, WIP mdsumner
+  if (exists("earthdata_token")) {
+    token <- earthdata_token
+  } else {
+    token <- get_earthdata_token(proc_opts$user, proc_opts$password)
+  }
 
   #   __________________________________________________________________________
   #   Start Working.                                                        ####

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
+  }
+

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
     )

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,15 +76,16 @@ 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)]
         getlist <- gsub(
           ".*>([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)
 }

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.