#26 add support for bearer (token) authentication

eblondel · Aug 2, 2019 · bc394b0 · bc394b0
1 parent 441d93f
commit bc394b0
Show file tree

Hide file tree

Showing 7 changed files with 41 additions and 25 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)){