From 47054254bb502646ca9d480b3cfa0cf0ad89738d Mon Sep 17 00:00:00 2001
From: JJ Allaire <jj@rstudio.org>
Date: Fri, 4 Oct 2013 19:20:07 -0400
Subject: [PATCH] add function to get service url

---
 R/http.R | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/R/http.R b/R/http.R
index 95496f7..ba81272 100644
--- a/R/http.R
+++ b/R/http.R
@@ -4,6 +4,26 @@ userAgent <- function() {
   paste("shinyapps", packageVersion("shinyapps"), sep="/")
 }
 
+serviceUrl <- function() {
+  parseHttpUrl(getOption("shinyapps.service_url", 
+                         "https://api.shinyapps.io/v1"))
+}
+
+parseHttpUrl <- function(urlText) {
+  
+  matches <- regexec("(http|https)://([^:/#?]+)(?::(\\d+))?(.*)", urlText)
+  components <- regmatches(urlText, matches)[[1]]
+  if (length(components) == 0)
+    stop("Invalid url: ", urlText)
+  
+  url <- list()
+  url$protocol <- components[[2]]
+  url$host <- components[[3]]
+  url$port <- components[[4]]
+  url$path <- components[[5]]
+  url
+}
+
 parseHttpHeader <- function(header) {
   split <- strsplit(header, ": ")[[1]]
   if (length(split) == 2)