Passing credentials to app with deployApp function

shiny
rstudio

#1

I am trying to deploy a shiny app on the Rstudio connect server using the shell script on the Centos 7 Jenkins CI server. I need to pass the database credentials to my application that is going to deploy on the rsconnect server. I am using the deployApp function for deploying my app.

The original shell script I am using is:
Step 1:

 sh "/bin/Rscript /home/jenkins/workspace/rsconnect401-test/deploy.R"

The above script calls the deploy.R script with function.

options(repos=c(CRAN='https://cran.rstudio.com'))
options(encoding = "UTF-8")

library(rsconnect)

deployApp(appDir = "./shiny"
                     ,appPrimaryDoc = "<script name. R>"
                     ,account = "<rstudio connect admin acct>"
                     ,server = "<rstudio connect server name>"
                     ,launch.browser = FALSE)

step 3: The deploy script call the application R ( <script name. R>) file with connection to the database.

################################################################################
# initial settings
#   - set the CRAN mirror as the cloud
################################################################################



options(repos=c(CRAN='https://cran.rstudio.com'))
options(encoding = "UTF-8")

################################################################################
# install packages (if missing)
################################################################################
# pkgs <- installed.packages()[,0]
# pkgs.need <- c("ggplot2","yaml","R.utils","rJava","shiny","scales","DBI", 'tibble')
# pkgs.missing <- pkgs.need[!pkgs.need %in% pkgs]
# if (length(pkgs.missing) > 0) {
#   install.packages(pkgs.missing, dep = TRUE)
# }
# 
# install.packages("rsconnect")

################################################################################
# Libraries
################################################################################
library(PKI)
library(RCurl)
library(httpuv)
library(sourcetools)
library(xtable)
library(ggplot2)
library(scales)
library(RJDBC)
library(DT)
library(XLConnect)
library(shiny)
library(shinydashboard)
library(rsconnect)
library(ROracle)
library(RJSONIO)
library(shiny)
library(mime)


writeLines("\n######################## Creating Embedded Email ###############################\n")
writeLines("\n############################ Loading Libraries #################################\n")





################################################################################
# functions
################################################################################

sys_date <- Sys.Date()
sys_date <- format(sys_date, format = "%m-%d-%Y")

chart_title <- "Unit Test Results for"
chart_title <- paste(chart_title, sys_date)

tab_script <- "var tab_switch = setInterval(function(){
                 var tabs = $('#tabset li'),
                 active = tabs.filter('.active'),
                 next = active.next('li'),
                 toClick = next.length ? next.find('a') : tabs.eq(0).find('a');
                 toClick.trigger('click');
                 }, 30000);"

################################################################################
# ui
################################################################################

ui <- fluidPage(
          tabsetPanel(id = "tabset",
              tabPanel("Results and Health"
                       ,align = "center"
                       #,h1(chart_title)
                       #,column(8, h2("Results")
                       #       ,plotOutput("p", height = "75vh", width = "50vh"))
                        ,column(12, h2("Data Intelligence Unit Test Status:")
                                ,plotOutput("sl_1", height = "30vh", width = "30vh")
                                ,plotOutput("sl_2", height = "30vh", width = "30vh")
                                ,plotOutput("sl_3", height = "30vh", width = "30vh")))
              ,tabPanel("Failed Tests"
                        ,align = "center"
                        ,h1("Failed Tests")
                        ,tableOutput("table")))
              #,tabPanel("Tab 3", h1("Tab 3")))
          ,tags$script(HTML(tab_script))
          )
                
################################################################################
# server
################################################################################

server <- function(input, output, session){

session$allowReconnect(TRUE)

################################################################################
# db connection
################################################################################


db_user <- Sys.getenv("set_user")
**db_pass <- Sys.getenv("set_userpw")**
## **db_pass variable is NOT available in this script. If the code is written as dbpass<- ##'clear_text_db_password' then the code deploy without issue**

con <- dbConnect(drv = dbDriver("Oracle"),
                   username = '<dbusername>',
                   password = db_pass,
                   dbname = "<database server string>"
                   )

################################################################################
# sql queries
################################################################################

fail <- dbGetQuery(con,
                   "
                   select a.report_num,
                          a.report_time,
                          a.result
                   from
                   (
                   select row_number() over(order by run_date) as report_num,
                          to_char(run_date, 'HH12:MI:ss') as report_time,
                          case when test_result like '%fail%' then 'fail' else 'pass' end as result
                   from dwh_analytical_reporting.unit_test_log
                   where trunc(run_date) = trunc(sysdate)
                   ) a
                   where a.result like '%fail%'
                   ")

total <- dbGetQuery(con,
                    "
                    select row_number() over(order by run_date) as report_num,
                           to_char(run_date, 'HH12:MI:ss') as report_time,
                           case when test_result like '%fail%' 
                                    then 'fail' 
                                else 'pass' end as result
                    from dwh_analytical_reporting.unit_test_log
                    where trunc(run_date) = trunc(sysdate)
                    ")

fail_table <- dbGetQuery(con,
                        "
                        select report_name,
                               test_name,
                               error_message,
                               to_char(run_date, 'yyyy-mm-dd hh:mm:ss') as run_date
                        from dwh_analytical_reporting.unit_test_log
                        where test_result like '%fail%'   
                          and trunc(run_date) = trunc(sysdate)
                        ")

fail_num <- dbGetQuery(con,
                       "
                       select count(*)
                       from dwh_analytical_reporting.unit_test_log
                       where trunc(run_date) = trunc(sysdate)
                         and test_result like '%fail%'
                       ")

total_num <- dbGetQuery(con,
                        "
                        select count(*)
                        from dwh_analytical_reporting.unit_test_log
                        where trunc(run_date) = trunc(sysdate)
                        ")

dbDisconnect(con)

################################################################################
# functions
################################################################################

fail_number <- fail_num[1,1]

pass_percent <- (total_num[1,1] - fail_num[1,1])/total_num[1,1]

df <- data.frame(x_axis = c("good", "bad"), y_axis = c(100, 0))

################################################################################
# output
################################################################################

output$table <- renderTable(fail_table)

p <- ggplot(data = total, aes(x = REPORT_TIME, y = REPORT_NUM, group = 1, color = RESULT)) +
            labs(x = "Report Time", y = "Report #") +
            geom_line(color = "#339900") +
            geom_point(color = "#339900", size = 2.5) +
            scale_y_continuous(breaks = seq(0, nrow(total), 5)) +
            theme_light() +
            theme(legend.position = c(.10, .90),
                  legend.box.background = element_rect(size = 1),
                  axis.title.x = element_text(face = "bold", size = 14),
                  axis.title.y = element_text(face = "bold", size = 14),
                  axis.text.x = element_text(angle = 45, face = "bold", size = 9, vjust = 0.5),
                  axis.text.y = element_text(face = "bold", size = 9))

if (fail_number == 0) {
p <- p + scale_color_manual(name = "Legend",
                            labels = c("Pass"),
                            values = c("#339900")) +
         guides(color = guide_legend(override.aes = list(size = c(2.5), linetype = 0)))
} else {
p <- p + geom_point(data = fail,
                    aes(x = REPORT_TIME, y = REPORT_NUM),
                    size = 5,
                    color = "red") +
         geom_segment(data = fail,
                      aes(x = REPORT_TIME, y = 0, xend = REPORT_TIME, yend = REPORT_NUM),
                      linetype = "dashed",
                      size = 1,
                      color = "red") +
         scale_color_manual(name = "Legend",
                            labels = c("Pass", "Fail"),
                            values = c("#339900", "red")) +
         guides(color = guide_legend(override.aes = list(size = c(2.5, 5), linetype = 0)))
}

output$p <- renderPlot(p)

sl_1 <- ggplot(data = df, aes(x = "", y = y_axis, fill = x_axis)) +
          geom_bar(width = 1,
                   stat = "identity",
                   alpha = ifelse((pass_percent >= .90), 1, .05),
                   fill = c("#339900", "#CC0000")) +
          coord_polar("y", start = 0) +
          theme_void()

sl_2 <- ggplot(data = df, aes(x = "", y = y_axis, fill = x_axis)) +
          geom_bar(width = 1,
                   stat = "identity",
                   alpha = ifelse((pass_percent < .90 & pass_percent >= .75), 1, .05),
                   fill = c("#FFCC00", "#CC0000")) +
          coord_polar("y", start = 0) +
          theme_void()

sl_3 <- ggplot(data = df, aes(x = "", y = y_axis, fill = x_axis)) +
          geom_bar(width = 1,
                   stat = "identity",
                   alpha = ifelse((pass_percent <= .75), 1, .05),
                   fill = c("#CC0000", "#CC0000")) +
          coord_polar("y", start = 0) +
          theme_void()
#legend <- legend("topleft", inset = c(-0.2, 0.4), legend = c(">=90%", "75%<=x<90%", "<75%")
 #                 ,col = c("#339900", "#FFCC00", "#FFCC00"), pch = 19, title = "Legend")


output$sl_1 <- renderPlot(sl_1)
output$sl_2 <- renderPlot(sl_2)
output$sl_3 <- renderPlot(sl_3)
#output$legend <- renderPlot(legend)


}

################################################################################
# run app
################################################################################

shinyApp(ui, server)

Question: As seen in the step 3, the variable values are not available for the database connection. But If the username and password are passed as clear text then application deploys without issue.

**db_pass <- Sys.getenv("set_userpw")**
## **db_pass variable is NOT available in this script. If the code is written as dbpass<- 'clear_text_db_password' then the code deploy without issue**

Thanks,
Milind