add netrc file authentication

DESCRIPTION

@@ -7,8 +7,8 @@ Encoding: UTF-8
 Language: en-US
 Depends: R (>= 4.0.0), terra (>= 1.6.41)
 LinkingTo: Rcpp, RcppArmadillo
-Imports: methods, Rcpp (>= 1.0-10)
-Suggests: httr, rvest, xml2, jsonlite, meteor, signal
+Imports: methods, Rcpp (>= 1.0-10), httr
+Suggests: rvest, xml2, jsonlite, meteor, signal
 Maintainer: Robert J. Hijmans <[email protected]>
 Description: Tools for acquiring and (pre-) processing satellite remote sensing data. Including for downloading data from NASA such as LANDSAT and MODIS.
 License: GPL (>=3)
@@ -20,3 +20,4 @@ Authors@R: c(
     person("Alex", "Mandel", role="ctb"),
     person("Benson", "Kenduiywo", role = "ctb"),
     person("Jakob", "Schwalb-Willmann", role = "ctb"))
+RoxygenNote: 7.3.2

R/RcppExports.R

@@ -1,7 +1,7 @@
-# Generated by using Rcpp::compileAttributes() -> do not edit by hand
-# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
-
-.nnls_solver <- function(x, A, iterate = 400L, tolerance = 0.000001) {
-    .Call('_luna_nnls_solver', PACKAGE = 'luna', x, A, iterate, tolerance)
-}
-
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+.nnls_solver <- function(x, A, iterate = 400L, tolerance = 0.000001) {
+    .Call(`_luna_nnls_solver`, x, A, iterate, tolerance)
+}
+

R/cmr.R

@@ -1,142 +1,160 @@
-# Authors: Alex Mandel, Aniruddha Ghosh, Robert J. Hijmans 
-# July 2019
-# Version 0.1
-# Licence GPL v3
-
-# Converted from the NASA official pyCMR
-# https://github.com/nasa/pyCMR
-
-#AUTH_HOST = 'urs.earthdata.nasa.gov'
-
-
-.get_search_results <- function(url, limit, kwargs){
-  #  Search the CMR granules
-  #:param limit: limit of the number of results
-  #:param kwargs: search parameters
-  #:return: list of results (<Instance of Result>)
-
-	page_num <- 1
-	results <- NULL
-
-	while (length(results) < limit){
-    #print(page_num)
-		response <- httr::GET(
-			url=url,
-		# TODO: fix next line to take all possible args passed via ...
-			httr::add_headers(Accept="text/csv"),
-			query=c(kwargs, page_num=page_num) 
-		#, page_size=self._PAGE_SIZE),
-		# headers=self._SEARCH_HEADER # what is the header passed from parent function?
-		)
-
-		# Check for a valid response
-		httr::stop_for_status(response)
-
-		#unparsed_page = content(response,parsed="application/json")
-		# parsing without messages
-		# http://r.789695.n4.nabble.com/httr-content-without-message-td4747453.html
-		if (httr::http_type(response) == "text/csv"){
-
-		# Per httr docs testing for expected type and parsing manually
-		#unparsed_page = readr::read_csv(httr::content(response, as="text"))
-			p <- utils::read.csv(text=httr::content(response, as="text"), check.names=FALSE, stringsAsFactors=FALSE)
-
-			#Check the URL column is not empty
-			catcher <- tryCatch(urls <- p[["Online Access URLs"]], error=function(e){e})
-
-			if(!inherits(catcher, "error")){
-				if(length(urls)==0){
-					break
-				}
-				# Append the full table of results
-				results <- rbind(results, p)
-				page_num <- page_num + 1
-			} else { 
-				break
-			}  
-		} else {
-		#The response was not a csv, we should throw and error?
-			break
-		}
-	}
-    return(results)
-}
-
-
-.searchCollection <- function(cmr_host="https://cmr.earthdata.nasa.gov", limit=100, ...){
-  # Search the CMR collections
-  # :param limit: limit of the number of results
-  # :param kwargs ...: search parameters
-  # :return: dataframe of results
-	SEARCH_COLLECTION_URL = paste0(cmr_host,"/search/collections")
-	results <- .get_search_results(url=SEARCH_COLLECTION_URL, limit=limit, ...)
-	return(results)
-}
-
-.cmr_download_one <- function(url, path, USERNAME, PASSWORD, overwrite, ...){
-  # Download a single result
-  # TODO check if file exists
-	outfile <- file.path(path, basename(url))
-	if ((!file.exists(outfile)) | overwrite){
-		if(!is.null(USERNAME)){
-			f <- httr::GET(url, httr::authenticate(USERNAME, PASSWORD), httr::progress(), httr::write_disk(outfile, overwrite = overwrite))
-		} else {
-			f <- utils::download.file(url, outfile, mode = "wb") 
-			return(f)
-		}
-	}
-	return(outfile)
-} 
-
-
-.cmr_download <- function(urls, path, username, password, overwrite, ...){
-  # Given a list of results, download all of them
-
-	files <- rep("", length(urls))
-	for (i in 1:length(urls)) {
-		f <- tryCatch(
-				.cmr_download_one(urls[i], path, username, password, overwrite), 
-				error = function(e){e}
-			)
-		if (inherits(f, "error")) {
-			warning("failure: ", urls[i])
-			f <- file.path(path, urls[i])
-			if ( isTRUE(file.info(f)$size < 1) ) file.remove(f)
-		} else {
-			files[i] = urls[i]
-		}
-	}
-	cat("\n")
-	return(files)
-}
-
-.searchGranules <- function(product="MOD09A1", start_date, end_date, extent, limit=100, datesuffix = "T00:00:00Z", ...){
-  #Search the CMR granules
-  #:param limit: limit of the number of results
-  #:param kwargs: search parameters
-  #:return: dataframe of results
-
-	e <- .getExtent(extent)
-
-	  # for testing validity
-	start_date <- as.Date(start_date)
-	end_date <- as.Date(end_date)
-
-	temporal <- paste0(start_date, datesuffix, ",", end_date, datesuffix)
-
-	params <- list(
-		short_name=product,	temporal=temporal, downloadable="true", bounding_box=e
-	)
-
-	pars <- list(...) 
-	if (length(pars) > 0) {
-		params <- c(params, pars)
-	}
-
-	cmr_host="https://cmr.earthdata.nasa.gov"
-	url <- file.path(cmr_host, "search/granules")
-	results <- .get_search_results(url=url, limit=limit, kwargs=params)
-	return(results) 
-}
-
-# CMR download attempt
+# Authors: Alex Mandel, Aniruddha Ghosh, Robert J. Hijmans 
+# July 2019
+# Version 0.1
+# Licence GPL v3
+
+# Converted from the NASA official pyCMR
+# https://github.com/nasa/pyCMR
+
+#AUTH_HOST = 'urs.earthdata.nasa.gov'
+
+
+.get_search_results <- function(url, limit, kwargs){
+  #  Search the CMR granules
+  #:param limit: limit of the number of results
+  #:param kwargs: search parameters
+  #:return: list of results (<Instance of Result>)
+
+	page_num <- 1
+	results <- NULL
+
+	while (length(results) < limit){
+    #print(page_num)
+		response <- httr::GET(
+			url=url,
+		# TODO: fix next line to take all possible args passed via ...
+			httr::add_headers(Accept="text/csv"),
+			query=c(kwargs, page_num=page_num) 
+		#, page_size=self._PAGE_SIZE),
+		# headers=self._SEARCH_HEADER # what is the header passed from parent function?
+		)
+
+		# Check for a valid response
+		httr::stop_for_status(response)
+
+		#unparsed_page = content(response,parsed="application/json")
+		# parsing without messages
+		# http://r.789695.n4.nabble.com/httr-content-without-message-td4747453.html
+		if (httr::http_type(response) == "text/csv"){
+
+		# Per httr docs testing for expected type and parsing manually
+		#unparsed_page = readr::read_csv(httr::content(response, as="text"))
+			p <- utils::read.csv(text=httr::content(response, as="text"), check.names=FALSE, stringsAsFactors=FALSE)
+
+			#Check the URL column is not empty
+			catcher <- tryCatch(urls <- p[["Online Access URLs"]], error=function(e){e})
+
+			if(!inherits(catcher, "error")){
+				if(length(urls)==0){
+					break
+				}
+				# Append the full table of results
+				results <- rbind(results, p)
+				page_num <- page_num + 1
+			} else { 
+				break
+			}  
+		} else {
+		#The response was not a csv, we should throw and error?
+			break
+		}
+	}
+    return(results)
+}
+
+
+.searchCollection <- function(cmr_host="https://cmr.earthdata.nasa.gov", limit=100, ...){
+  # Search the CMR collections
+  # :param limit: limit of the number of results
+  # :param kwargs ...: search parameters
+  # :return: dataframe of results
+	SEARCH_COLLECTION_URL = paste0(cmr_host,"/search/collections")
+	results <- .get_search_results(url=SEARCH_COLLECTION_URL, limit=limit, ...)
+	return(results)
+}
+
+.cmr_download_one <- function(url, path, netrc, overwrite, ...){
+  # Download a single result
+  # TODO check if file exists
+	outfile <- file.path(path, basename(url))
+	if ((!file.exists(outfile)) | overwrite){
+		if(!is.null(netrc)){
+			f = GET(url, write_disk(outfile, overwrite = overwrite), progress(),
+			                config(netrc = TRUE, netrc_file = netrc), set_cookies("LC" = "cookies"))
+		} else {
+			f <- utils::download.file(url, outfile, mode = "wb") 
+			return(f)
+		}
+	}
+	return(outfile)
+} 
+
+.get_netrc = function(username, password) {
+  usr <- file.path(Sys.getenv("USERPROFILE")) # Retrieve home dir (for netrc file)
+  if (usr == "") {usr = Sys.getenv("HOME")} # If no user profile exists, use home
+  netrc <- file.path(usr,'.netrc', fsep = .Platform$file.sep) # Path to netrc file
+
+  if (file.exists(netrc) == FALSE || grepl("urs.earthdata.nasa.gov", readLines(netrc)[1]) == FALSE) {
+    netrc_conn <- file(netrc)
+
+    # User will be prompted for NASA Earthdata Login Username and Password below
+    writeLines(c("machine urs.earthdata.nasa.gov",
+                 sprintf("login %s", username),
+                 sprintf("password %s", password)), netrc_conn)
+    close(netrc_conn)
+  }
+  netrc <- file.path(usr,'.netrc', fsep = .Platform$file.sep) # Path to netrc file
+  return(netrc)
+}
+
+.cmr_download <- function(urls, path, username, password, overwrite, ...){
+  # Given a list of results, download all of them
+  netrc = .get_netrc(username, password) # get netrc file
+	files <- rep("", length(urls))
+	for (i in 1:length(urls)) {
+		f <- tryCatch(
+				.cmr_download_one(urls[i], path, netrc, overwrite), 
+				error = function(e){e}
+			)
+		if (inherits(f, "error")) {
+			warning("failure: ", urls[i])
+			f <- file.path(path, urls[i])
+			if ( isTRUE(file.info(f)$size < 1) ) file.remove(f)
+		} else {
+			files[i] = urls[i]
+		}
+	}
+	cat("\n")
+	return(files)
+}
+
+.searchGranules <- function(product="MOD09A1", start_date, end_date, extent, limit=100, datesuffix = "T00:00:00Z", ...){
+  #Search the CMR granules
+  #:param limit: limit of the number of results
+  #:param kwargs: search parameters
+  #:return: dataframe of results
+
+	e <- .getExtent(extent)
+
+	  # for testing validity
+	start_date <- as.Date(start_date)
+	end_date <- as.Date(end_date)
+
+	temporal <- paste0(start_date, datesuffix, ",", end_date, datesuffix)
+
+	params <- list(
+		short_name=product,	temporal=temporal, downloadable="true", bounding_box=e
+	)
+
+	pars <- list(...) 
+	if (length(pars) > 0) {
+		params <- c(params, pars)
+	}
+
+	cmr_host="https://cmr.earthdata.nasa.gov"
+	url <- file.path(cmr_host, "search/granules")
+	results <- .get_search_results(url=url, limit=limit, kwargs=params)
+	return(results) 
+}
+
+# CMR download attempt