diff --git a/R/CSWClient.R b/R/CSWClient.R index e7f0ebb..d9b3f0b 100644 --- a/R/CSWClient.R +++ b/R/CSWClient.R @@ -26,10 +26,10 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(url, serviceVersion, user, pwd, logger)}}{ +#' \item{\code{new(url, serviceVersion, user, pwd, token, logger)}}{ #' This method is used to instantiate a CSWClient with the \code{url} of the -#' OGC service. Authentication (\code{user}/\code{pwd}) is not yet supported and will -#' be added with the support of service transactional modes. By default, the \code{logger} +#' OGC service. Authentication is supported either with a basic (\code{user}/\code{pwd}) +#' authentication or a \code{token}-based authentication. By default, the \code{logger} #' argument will be set to \code{NULL} (no logger). This argument accepts two possible #' values: \code{INFO}: to print only \pkg{ows4R} logs, \code{DEBUG}: to print more verbose logs #' } @@ -63,9 +63,9 @@ CSWClient <- R6Class("CSWClient", ), public = list( #initialize - initialize = function(url, serviceVersion = NULL, user = NULL, pwd = NULL, logger = NULL) { + initialize = function(url, serviceVersion = NULL, user = NULL, pwd = NULL, token = NULL, logger = NULL) { if(startsWith(serviceVersion, "3.0")) serviceVersion <- "3.0.0" - super$initialize(url, service = private$serviceName, serviceVersion, user, pwd, logger) + super$initialize(url, service = private$serviceName, serviceVersion, user, pwd, token, logger) self$capabilities = CSWCapabilities$new(self$url, self$version, logger = logger) }, @@ -108,7 +108,7 @@ CSWClient <- R6Class("CSWClient", stop(errorMsg) } request <- CSWGetRecordById$new(op, self$getUrl(), self$getVersion(), - user = self$getUser(), pwd = self$getPwd(), + user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), id = id, elementSetName = elementSetName, logger = self$loggerType, ...) return(request$getResponse()) @@ -132,7 +132,7 @@ CSWClient <- R6Class("CSWClient", if(hasMaxRecords) if(maxRecords < maxRecordsPerRequest) maxRecordsPerRequest <- maxRecords firstRequest <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(), - user = self$getUser(), pwd = self$getPwd(), + user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), query = query, logger = self$loggerType, maxRecords = maxRecordsPerRequest, ...) records <- firstRequest$getResponse() @@ -159,7 +159,7 @@ CSWClient <- R6Class("CSWClient", } } nextRequest <- CSWGetRecords$new(op, self$getUrl(), self$getVersion(), - user = self$getUser(), pwd = self$getPwd(), + user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), query = query, logger = self$loggerType, startPosition = nextRecord, maxRecords = maxRecordsPerRequest, ...) @@ -194,7 +194,7 @@ CSWClient <- R6Class("CSWClient", } #transation transaction <- CSWTransaction$new(op, cswt_url, self$getVersion(), type = type, - user = self$getUser(), pwd = self$getPwd(), + user = self$getUser(), pwd = self$getPwd(), token = self$getToken(), record = record, recordProperty = recordProperty, constraint = constraint, logger = self$loggerType, ...) diff --git a/R/CSWGetRecordById.R b/R/CSWGetRecordById.R index aa94f70..310ef48 100644 --- a/R/CSWGetRecordById.R +++ b/R/CSWGetRecordById.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(op, url, serviceVersion, user, pwd, id, elementSetName, logger, ...)}}{ +#' \item{\code{new(op, url, serviceVersion, user, pwd, token, id, elementSetName, logger, ...)}}{ #' This method is used to instantiate a CSWGetRecordById object #' } #' } @@ -32,7 +32,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", Id = NA, ElementSetName = "full", initialize = function(op, url, serviceVersion = "2.0.2", - user = NULL, pwd = NULL, + user = NULL, pwd = NULL, token = NULL, id, elementSetName = "full", logger = NULL, ...) { self$Id = id allowedElementSetNames <- c("full", "brief", "summary") @@ -42,7 +42,7 @@ CSWGetRecordById <- R6Class("CSWGetRecordById", } self$ElementSetName = elementSetName super$initialize(op, "POST", url, request = private$xmlElement, - user = user, pwd = pwd, + user = user, pwd = pwd, token = token, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) diff --git a/R/CSWGetRecords.R b/R/CSWGetRecords.R index 08eab98..06136d7 100644 --- a/R/CSWGetRecords.R +++ b/R/CSWGetRecords.R @@ -8,7 +8,7 @@ #' #' @section Methods: #' \describe{ -#' \item{\code{new(op, url, serviceVersion, user, pwd, query, logger, ...)}}{ +#' \item{\code{new(op, url, serviceVersion, user, pwd, token, query, logger, ...)}}{ #' This method is used to instantiate a CSWGetRecords object #' } #' } @@ -35,10 +35,10 @@ CSWGetRecords <- R6Class("CSWGetRecords", public = list( Query = NULL, initialize = function(op, url, serviceVersion = "2.0.2", - user = NULL, pwd = NULL, + user = NULL, pwd = NULL, token = NULL, query = NULL, logger = NULL, ...) { super$initialize(op, "POST", url, request = private$xmlElement, - user = user, pwd = pwd, + user = user, pwd = pwd, token = token, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) nsVersion <- ifelse(serviceVersion=="3.0.0", "3.0", serviceVersion) diff --git a/R/CSWHarvest.R b/R/CSWHarvest.R index bfbdeec..e34f4b8 100644 --- a/R/CSWHarvest.R +++ b/R/CSWHarvest.R @@ -32,13 +32,13 @@ CSWHarvest <- R6Class("CSWHarvest", ResourceType = "http://www.isotc211.org/2005/gmd", ResourceFormat = "application/xml", initialize = function(op, url, serviceVersion = "2.0.2", - user = NULL, pwd = NULL, + user = NULL, pwd = NULL, token = NULL, source = NULL, resourceType = "http://www.isotc211.org/schemas/2005/gmd/", resourceFormat = "application/xml", logger = NULL, ...) { super$initialize(op, "POST", url, request = private$xmlElement, - user = user, pwd = pwd, + user = user, pwd = pwd, token = token, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) nsVersion <- ifelse(serviceVersion=="3.0.0", "3.0", serviceVersion) diff --git a/R/CSWTransaction.R b/R/CSWTransaction.R index 2bd313c..28e63dc 100644 --- a/R/CSWTransaction.R +++ b/R/CSWTransaction.R @@ -25,7 +25,7 @@ CSWTransaction <- R6Class("CSWTransaction", xmlNamespace = c(csw = "http://www.opengis.net/cat/csw") ), public = list( - initialize = function(op, url, serviceVersion, type, user = NULL, pwd = NULL, + initialize = function(op, url, serviceVersion, type, user = NULL, pwd = NULL, token = NULL, record = NULL, recordProperty = NULL, constraint = NULL, logger = NULL, ...) { nsVersion <- ifelse(serviceVersion=="3.0.0", "3.0", serviceVersion) @@ -38,7 +38,7 @@ CSWTransaction <- R6Class("CSWTransaction", constraint = constraint ) super$initialize(op, "POST", url, request = private$xmlElement, - user = user, pwd = pwd, + user = user, pwd = pwd, token = token, contentType = "text/xml", mimeType = "text/xml", logger = logger, ...) self$wrap <- TRUE diff --git a/R/OWSClient.R b/R/OWSClient.R index 80250a3..b42bec3 100644 --- a/R/OWSClient.R +++ b/R/OWSClient.R @@ -50,7 +50,8 @@ OWSClient <- R6Class("OWSClient", #TODO provider specific formatter to prevent these fields to be printable private = list( user = NULL, - pwd = NULL + pwd = NULL, + token = NULL ), public = list( @@ -62,7 +63,7 @@ OWSClient <- R6Class("OWSClient", #initialize initialize = function(url, service, serviceVersion, - user = NULL, pwd = NULL, + user = NULL, pwd = NULL, token = NULL, logger = NULL) { #logger @@ -75,6 +76,7 @@ OWSClient <- R6Class("OWSClient", #authentication private$user <- user private$pwd <- pwd + private$token <- token }, #getUrl @@ -100,6 +102,11 @@ OWSClient <- R6Class("OWSClient", #getPwd getPwd = function(){ return(private$pwd) + }, + + #getToken + getToken = function(){ + return(private$token) } ) diff --git a/R/OWSRequest.R b/R/OWSRequest.R index 3b205df..ddcba69 100644 --- a/R/OWSRequest.R +++ b/R/OWSRequest.R @@ -57,6 +57,7 @@ OWSRequest <- R6Class("OWSRequest", user = NULL, pwd = NULL, token = NULL, + auth_scheme = NULL, #GET #--------------------------------------------------------------- @@ -71,7 +72,7 @@ OWSRequest <- R6Class("OWSRequest", #headers headers <- c() if(!is.null(private$token)){ - headers <- c(headers, "Authorization" = paste("Basic", private$token)) + headers <- c(headers, "Authorization" = paste(private$auth_scheme, private$token)) } r <- NULL @@ -107,7 +108,7 @@ OWSRequest <- R6Class("OWSRequest", #headers headers <- c("Accept" = "application/xml", "Content-Type" = contentType) if(!is.null(private$token)){ - headers <- c(headers, "Authorization" = paste("Basic", private$token)) + headers <- c(headers, "Authorization" = paste(private$auth_scheme, private$token)) } #send request @@ -146,7 +147,7 @@ OWSRequest <- R6Class("OWSRequest", public = list( #initialize initialize = function(op, type, url, request, - user = NULL, pwd = NULL, + user = NULL, pwd = NULL, token = NULL, namedParams = NULL, attrs = NULL, contentType = "text/xml", mimeType = "text/xml", logger = NULL, ...) { @@ -158,12 +159,20 @@ OWSRequest <- R6Class("OWSRequest", private$contentType = contentType private$mimeType = mimeType + #authentication schemes if(!is.null(user) && !is.null(pwd)){ + #Basic authentication (user/pwd) scheme + private$auth_scheme = "Basic" private$user = user private$pwd = pwd private$token = openssl::base64_encode(charToRaw(paste(user, pwd, sep=":"))) } - + if(!is.null(token)){ + #Token/Bearer authentication + private$auth_scheme = "Bearer" + private$token = token + } + vendorParams <- list(...) #if(!is.null(op)){ # for(param in names(vendorParams)){