From a93bff27bac17aca1776bf89868592cd50a9e1e7 Mon Sep 17 00:00:00 2001 From: Richard Beare Date: Tue, 1 Nov 2016 18:46:31 +1100 Subject: [PATCH 1/3] Signing of URLs for google queries when using a digital signature. Cleanup of mapdist so that a group of distances are computed in a single query. --- DESCRIPTION | 4 +- R/geocode.R | 15 ++++--- R/get_googlemap.R | 12 +++-- R/mapdist.R | 109 +++++++++++++++++++++++++++------------------- R/revgeocode.R | 12 +++-- R/route.R | 11 +++-- R/trek.R | 11 +++-- R/urlsigning.R | 22 ++++++++++ man/mapdist.Rd | 8 +++- man/signurl.Rd | 27 ++++++++++++ 10 files changed, 165 insertions(+), 66 deletions(-) create mode 100644 R/urlsigning.R create mode 100644 man/signurl.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 45d270e..9925c78 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,9 @@ Imports: digest, scales, dplyr, - bitops + bitops, + base64enc, + urltools Suggests: MASS, stringr, diff --git a/R/geocode.R b/R/geocode.R index 27b7a01..8355eac 100644 --- a/R/geocode.R +++ b/R/geocode.R @@ -99,8 +99,6 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"), nameType <- match.arg(nameType) source <- match.arg(source) - - # vectorize for many locations if(length(location) > 1){ # set limit @@ -135,13 +133,15 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"), # start constructing the url posturl <- URLencode(location, reserved = TRUE) + NeedToSign <- FALSE if(source == "google"){ # add google account stuff if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&") + #signature <- goog_signature() + posturl <- paste(posturl, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() posturl <- paste(posturl, fmteq(key), sep = "&") @@ -165,8 +165,11 @@ geocode <- function(location, output = c("latlon", "latlona", "more", "all"), if(urlonly) return(url_string) url_hash <- digest::digest(url_string) - - + if (NeedToSign) { + # Sign if we are using google client and digital signature + url_string <- signurl(url_string, secret=goog_signature()) + } + # lookup info if on file if(isGeocodedInformationOnFile(url_hash) && force == FALSE){ diff --git a/R/get_googlemap.R b/R/get_googlemap.R index 9869049..8841be6 100644 --- a/R/get_googlemap.R +++ b/R/get_googlemap.R @@ -133,7 +133,6 @@ get_googlemap <- function( ##### do argument checking ############################################################ - args <- as.list(match.call(expand.dots = TRUE)[-1]) argsgiven <- names(args) @@ -309,10 +308,11 @@ get_googlemap <- function( sep = "&") # add google account stuff + NeedToSign <- FALSE if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - post_url <- paste(post_url, fmteq(client), fmteq(signature), sep = "&") + post_url <- paste(post_url, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() post_url <- paste(post_url, fmteq(key), sep = "&") @@ -331,7 +331,11 @@ get_googlemap <- function( if(urlonly) return(url) if(nchar(url) > 2048) stop("max url length is 2048 characters.", call. = FALSE) - + if (NeedToSign) { + # Sign if we are using google client and digital signature + url <- signurl(url, secret=goog_signature()) + } + ##### get map ############################################################ diff --git a/R/mapdist.R b/R/mapdist.R index 1dadc4d..3553097 100644 --- a/R/mapdist.R +++ b/R/mapdist.R @@ -17,6 +17,8 @@ #' (.GoogleDistQueryCount) #' @param ext domain extension (e.g. "com", "co.nz") #' @param inject character string to add to the url +#' @param usingPlaceIDs indicate that from and to fields contain placeIDs. +#' Turns of URL encoding of addresses. #' @param ... ... #' @return a data frame (output="simple") or all of the geocoded #' information (output="all") @@ -24,6 +26,9 @@ #' @details if parameters from and to are specified as geographic #' coordinates, they are reverse geocoded with revgeocode. note #' that the google maps api limits to 2500 element queries a day. +#' +#' mapdist now makes a single query to the mapdist api. The returned +#' data frame will have length(from)*length(to) rows #' @seealso #' \url{http://code.google.com/apis/maps/documentation/distancematrix/} #' @export @@ -61,7 +66,7 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit"), output = c("simple","all"), messaging = FALSE, language = "en-EN", urlonly = FALSE, override_limit = FALSE, - ext = "com", inject = "", ...) + ext = "com", inject = "", usingPlaceIDs=FALSE, ...) { # check parameters @@ -69,28 +74,37 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" stopifnot(is.character(from)) if(is.numeric(to) && length(to) == 2) to <- revgeocode(to) stopifnot(is.character(to)) - from_to_df <- data.frame(from = from, to = to, stringsAsFactors = FALSE) + + # Don't need to ensure that # from = # to - that happens in google + origins <- from + destinations <- to # this ensures # from = # to + mode <- match.arg(mode) output <- match.arg(output) stopifnot(is.logical(messaging)) - getdists <- function(df){ - + getdists <- function(From, To){ # format basic url - origins <- URLencode(df$from[1], reserved = TRUE) - destinations <- URLencode(df$to, reserved = TRUE) + if (usingPlaceIDs) { + origins <- From + destinations <- To + } else { + origins <- sapply(From, URLencode, reserved = TRUE) + destinations <- sapply(To, URLencode, reserved = TRUE) + } posturl <- paste( - fmteq(origins), fmteq(destinations, paste, collapse = "|"), + fmteq(origins, paste, collapse = "|"), fmteq(destinations, paste, collapse = "|"), fmteq(mode), fmteq(language), sep = "&" ) # add google account stuff + NeedToSign <- FALSE if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&") + posturl <- paste(posturl, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() posturl <- paste(posturl, fmteq(key), sep = "&") @@ -104,13 +118,17 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" # inject if(inject != "") url_string <- paste(url_string, inject, sep = "&") - # encode url_string <- URLencode( enc2utf8(url_string) ) if(urlonly) return(url_string) - # check if query is too long - if(nchar(url_string) >= 2048){ + if (NeedToSign) { + # Sign if we are using google client and digital signature + url_string <- signurl(url_string, secret=goog_signature()) + } + # check if query is too long - not sure if the signature is included + # in the maximum length - sign before check to be surTT$e. + if(nchar(url_string) >= 8192){ n <- nrow(df) half_df <- floor(n/2) return( @@ -121,8 +139,8 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" ) } - # check/update google query limit - check_dist_query_limit(url_string, elems = nrow(df), + # check/update google query limit - this is a single query + check_dist_query_limit(url_string, elems = 1, override = override_limit, messaging = messaging) @@ -132,50 +150,51 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" tree <- fromJSON(paste(readLines(connect), collapse = "")) check_google_for_error(tree) - # message user message(paste0("Source : ", url_string)) - # label destinations - first check if all were found - if(length(df$to) != length(tree$destination_addresses)){ + if(length(To) != length(tree$destination_addresses)){ message("matching was not perfect, returning what was found.") - names( tree$rows[[c(1,1)]] ) <- tree$destination_addresses output <<- "all" - # stringdist::amatch(df$to, tree$destination_addresses, maxDist = 10) - } else { - names( tree$rows[[c(1,1)]] ) <- df$to - } - - # return - tree$rows[[c(1,1)]] + } + if(length(From) != length(tree$origin_addresses)){ + message("matching was not perfect, returning what was found.") + output <<- "all" + } + return(tree) } - out <- dlply(from_to_df, "from", getdists) + out <- getdists(origins, destinations) # return all if(output == "all") return(out) - - - + + # out$rows has length(from) + # out$rows[[j]]$elements has length(to) # format output - out <- - ldply(out, function(oneFromList){ - ldply(oneFromList, function(oneToList){ - data.frame( - m = oneToList$distance$value, - km = oneToList$distance$value/1000, - miles = 0.0006214 * oneToList$distance$value, - seconds = oneToList$duration$value, - minutes = oneToList$duration$value / 60, - hours = oneToList$duration$value / 3600 - ) - }) + out_df <- plyr::ldply(out$rows, function(aToList){ + res <- plyr::ldply(aToList[[1]], function(oneToList){ + data.frame( + m = oneToList$distance$value, + km = oneToList$distance$value/1000, + miles = 0.0006214 * oneToList$distance$value, + seconds = oneToList$duration$value, + minutes = oneToList$duration$value / 60, + hours = oneToList$duration$value / 3600 + ) }) - - names(out) <- c("from", "to", names(out)[3:ncol(out)]) - + return(res) + }) + + destadd <- rep(out$destination_addresses, length(out$origin_addresses)) + originadd <- rep(out$origin_address, rep(length(out$destination_addresses), length(out$origin_addresses))) + + tos <- rep(to, length(from)) + froms <- rep(from, rep(length(to), length(from))) + + from_to_df <- data.frame(destination.address=destadd, origin.address=originadd, from=froms, to=tos) # "simple" return - suppressMessages(join(from_to_df, out)) + suppressMessages(cbind(from_to_df, out_df)) } diff --git a/R/revgeocode.R b/R/revgeocode.R index 738c9a5..4b4126f 100644 --- a/R/revgeocode.R +++ b/R/revgeocode.R @@ -51,10 +51,11 @@ revgeocode <- function(location, output = c("address","more","all"), ) # do google credentials + NeedToSign <- FALSE if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - url_string <- paste(url_string, fmteq(client), fmteq(signature), sep = "&") + url_string <- paste(url_string, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() url_string <- paste(url_string, fmteq(key), sep = "&") @@ -67,7 +68,12 @@ revgeocode <- function(location, output = c("address","more","all"), url_string <- URLencode( enc2utf8(url_string) ) if(urlonly) return(url_string) - # check/update google query limit + if (NeedToSign) { + # Sign if we are using google client and digital signature + url_string <- signurl(url_string, secret=goog_signature()) + } + + # check/update google query limit check <- checkGeocodeQueryLimit(url_string, elems = 1, override = override_limit, messaging = messaging) if(check == "stop"){ diff --git a/R/route.R b/R/route.R index 822576c..26acc6b 100644 --- a/R/route.R +++ b/R/route.R @@ -87,10 +87,12 @@ route <- function(from, to, mode = c("driving","walking","bicycling", "transit") ) # add google account stuff + NeedToSign <- FALSE if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&") + #signature <- goog_signature() + posturl <- paste(posturl, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() posturl <- paste(posturl, fmteq(key), sep = "&") @@ -112,7 +114,10 @@ route <- function(from, to, mode = c("driving","walking","bicycling", "transit") # check/update google query limit check_route_query_limit(url_string, elems = 1, override = override_limit, messaging = messaging) - + if (NeedToSign) { + # Sign if we are using google client and digital signature + url_string <- signurl(url_string, secret=goog_signature()) + } # distance lookup if(messaging) message("trying url ", url_string) connect <- url(url_string); on.exit(close(connect), add = TRUE) diff --git a/R/trek.R b/R/trek.R index b8b5406..1d25b8b 100644 --- a/R/trek.R +++ b/R/trek.R @@ -114,10 +114,11 @@ trek <- function(from, to, mode = c("driving","walking","bicycling", "transit"), ) # add google account stuff + NeedToSign <- FALSE if (has_goog_client() && has_goog_signature()) { + NeedToSign <- TRUE client <- goog_client() - signature <- goog_signature() - posturl <- paste(posturl, fmteq(client), fmteq(signature), sep = "&") + posturl <- paste(posturl, fmteq(client), sep = "&") } else if (has_goog_key()) { key <- goog_key() posturl <- paste(posturl, fmteq(key), sep = "&") @@ -141,7 +142,11 @@ trek <- function(from, to, mode = c("driving","walking","bicycling", "transit"), check_route_query_limit(url_string, elems = 1, override = override_limit, messaging = messaging) - + if (NeedToSign) { + # Sign if we are using google client and digital signature + url_string <- signurl(url_string, secret=goog_signature()) + } + # distance lookup if(messaging) message("trying url ", url_string) connect <- url(url_string) diff --git a/R/urlsigning.R b/R/urlsigning.R new file mode 100644 index 0000000..fbfec38 --- /dev/null +++ b/R/urlsigning.R @@ -0,0 +1,22 @@ +#' Sign a url using a google digital signature +#' @author Richard Beare +#' @param input_url The url to be signed. Should include a client field. +#' @param secret The private key +#' @return The signed url +#' @details Derived from the python urlsigner: +#' https://raw.githubusercontent.com/googlemaps/js-v2-samples/61b3f58eb1286a428843f8401048226b8648a76b/urlsigning/urlsigner.py +#' +signurl <- function(input_url, secret) +{ + secret.safe <- chartr("-_", "+/", secret) + decoded_key <- base64enc::base64decode(secret.safe) + # break up the url + urlparsed <- urltools::url_parse(input_url) + url_to_sign <- paste0("/", urlparsed$path, "?", urlparsed$parameter) + signature <- digest::hmac(decoded_key, url_to_sign, algo="sha1", raw=TRUE) + enc1 <- base64enc::base64encode(signature, linewidth=NA) + urlsafesig <- chartr("+/", "-_", enc1) + originalurl <- urltools::url_compose(urlparsed) + finalurl <- paste0(originalurl, "&signature=", urlsafesig) + return(finalurl) +} diff --git a/man/mapdist.Rd b/man/mapdist.Rd index f1d419c..e6e5554 100644 --- a/man/mapdist.Rd +++ b/man/mapdist.Rd @@ -7,7 +7,7 @@ mapdist(from, to, mode = c("driving", "walking", "bicycling", "transit"), output = c("simple", "all"), messaging = FALSE, language = "en-EN", urlonly = FALSE, override_limit = FALSE, ext = "com", inject = "", - ...) + usingPlaceIDs = FALSE, ...) } \arguments{ \item{from}{name of origin addresses in a data frame (vector @@ -33,6 +33,9 @@ accepted)} \item{inject}{character string to add to the url} +\item{usingPlaceIDs}{indicate that from and to fields contain placeIDs. +Turns of URL encoding of addresses.} + \item{...}{...} } \value{ @@ -48,6 +51,9 @@ Terms of Service at https://developers.google.com/maps/terms. if parameters from and to are specified as geographic coordinates, they are reverse geocoded with revgeocode. note that the google maps api limits to 2500 element queries a day. + + mapdist now makes a single query to the mapdist api. The returned + data frame will have length(from)*length(to) rows } \examples{ diff --git a/man/signurl.Rd b/man/signurl.Rd new file mode 100644 index 0000000..ae1c19a --- /dev/null +++ b/man/signurl.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/urlsigning.R +\name{signurl} +\alias{signurl} +\title{Sign a url using a google digital signature} +\usage{ +signurl(input_url, secret) +} +\arguments{ +\item{input_url}{The url to be signed. Should include a client field.} + +\item{secret}{The private key} +} +\value{ +The signed url +} +\description{ +Sign a url using a google digital signature +} +\details{ +Derived from the python urlsigner: +https://raw.githubusercontent.com/googlemaps/js-v2-samples/61b3f58eb1286a428843f8401048226b8648a76b/urlsigning/urlsigner.py +} +\author{ +Richard Beare +} + From 26335cfe3951a66f2f209cedea957023b173e582 Mon Sep 17 00:00:00 2001 From: Richard Beare Date: Mon, 14 May 2018 13:22:15 +1000 Subject: [PATCH 2/3] needed to turn off simplification of json - otherwise fromJSON was dropping the interesting bits --- R/mapdist.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/mapdist.R b/R/mapdist.R index 3553097..18c2245 100644 --- a/R/mapdist.R +++ b/R/mapdist.R @@ -17,7 +17,7 @@ #' (.GoogleDistQueryCount) #' @param ext domain extension (e.g. "com", "co.nz") #' @param inject character string to add to the url -#' @param usingPlaceIDs indicate that from and to fields contain placeIDs. +#' @param usingPlaceIDs indicate that from and to fields contain placeIDs. #' Turns of URL encoding of addresses. #' @param ... ... #' @return a data frame (output="simple") or all of the geocoded @@ -26,7 +26,7 @@ #' @details if parameters from and to are specified as geographic #' coordinates, they are reverse geocoded with revgeocode. note #' that the google maps api limits to 2500 element queries a day. -#' +#' #' mapdist now makes a single query to the mapdist api. The returned #' data frame will have length(from)*length(to) rows #' @seealso @@ -147,7 +147,7 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" # distance lookup if(messaging) message("trying url ", url_string) connect <- url(url_string); on.exit(close(connect), add = TRUE) - tree <- fromJSON(paste(readLines(connect), collapse = "")) + tree <- rjson::fromJSON(paste(readLines(connect), collapse = ""), simplify=FALSE) check_google_for_error(tree) # message user @@ -156,11 +156,11 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" if(length(To) != length(tree$destination_addresses)){ message("matching was not perfect, returning what was found.") output <<- "all" - } + } if(length(From) != length(tree$origin_addresses)){ message("matching was not perfect, returning what was found.") output <<- "all" - } + } return(tree) } @@ -168,7 +168,7 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" # return all if(output == "all") return(out) - + # out$rows has length(from) # out$rows[[j]]$elements has length(to) # format output @@ -185,10 +185,10 @@ mapdist <- function(from, to, mode = c("driving","walking","bicycling","transit" }) return(res) }) - + destadd <- rep(out$destination_addresses, length(out$origin_addresses)) originadd <- rep(out$origin_address, rep(length(out$destination_addresses), length(out$origin_addresses))) - + tos <- rep(to, length(from)) froms <- rep(from, rep(length(to), length(from))) From aa8d4f05db9d9d29ccba081c482b31c0a4dbe064 Mon Sep 17 00:00:00 2001 From: Richard Beare Date: Tue, 31 Jul 2018 13:30:04 +1000 Subject: [PATCH 3/3] Hack to deal with .all_aesthetics error --- R/ggplot2.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggplot2.R b/R/ggplot2.R index b296013..e3ceaf1 100644 --- a/R/ggplot2.R +++ b/R/ggplot2.R @@ -4,7 +4,7 @@ # Stat <- get("Stat", envir = asNamespace("ggplot2")) is.constant <- get("is.constant", envir = asNamespace("ggplot2")) rename_aes <- get("rename_aes", envir = asNamespace("ggplot2")) -.all_aesthetics <- get(".all_aesthetics", envir = asNamespace("ggplot2")) +.all_aesthetics <- ggplot2:::ggplot_global$all_aesthetics list_to_dataframe <- get("list_to_dataframe", envir = asNamespace("plyr"))