RStudioServer から ShinyApp を直接デプロイしたい

現在 CentOS 7.5 サーバーに RStudioServer と ShinyServer を入れて RStuidio 上で ShinyApp を書いています。

デプロイするには /srv/shiny-server/ の下にフォルダを丸ごとコピーしていますが、サーバにいちいちログインするか RStudio の新機能である Terminal 上でコピーしちゃうんですが、これを R でやりたいというのが今日のお題です。

適当に書くと次のようになると思います。

deploy_shiny_app <- function() {
  # 現在のワーキングディレクトリに ShinyApp があるとする
  dir_path <- getwd()
  # ShinyApp のデフォルトのデプロイ場所は /srv/shiny-server/
  target_dir_path <- file.path("/srv/shiny-server", basename(dir_path))
  # ShinyApp のフォルダにある .R ファイルを全て取得
  files <- list.files(dir_path, pattern = "\.R$", full.names = TRUE)
  # sudo cp コマンドで全てコピー
  command <- sprintf("sudo cp -vfu %s %s", paste(files, collapse = " "), 
                     target_dir_path)
  system(command, input = rstudioapi::askForPassword("Enter password"))
}

rstudioapi::askForPassword() というのはコード上にパスワードを平打ちしたくない時にこれ書いとくと RStudio 上でパスワードを入力するプロンプト出してくれるナウいやつです。

さて、これを実行すると次のようなエラーが出ました。

sudo: no tty present and no askpass program specified

これはなんかセキュリティ的な制限で、デフォルトでは sudo 時のパスワードが表示されないようにしてるみたいです。 解除するには

$ sudo visudo

で sudoers ファイルを開いて

Defaults visiblepw

と書くと良いらしいです。

さて、これで実行するとうまくコマンドが実行されるわけですが、デプロイ先のフォルダがないとエラーが出てコピーできません。 なので、フォルダがなければ作るということをやります。

sudo_create_dir_if_not_exists <- function(dir_path) {
  if (!dir.exists(dir_path)) {
    command <- sprintf("sudo mkdir %s", dir_path)
    prompt <- sprintf("Create %s", basename(dir_path))
    system(command, input = rstudioapi::askForPassword(prompt))
  }
}

deploy_shiny_app <- function() {
  # 現在のワーキングディレクトリに ShinyApp があるとする
  dir_path <- getwd()
  # ShinyApp のデフォルトのデプロイ場所は /srv/shiny-server/
  target_dir_path <- file.path("/srv/shiny-server", basename(dir_path))
  # なければ作る
  sudo_create_dir_if_not_exists(target_dir_path)
  # ShinyApp のフォルダにある .R ファイルを全て取得
  files <- list.files(dir_path, pattern = "\.R$", full.names = TRUE)
  # sudo cp コマンドで全てコピー
  command <- sprintf("sudo cp -vfu %s %s", paste(files, collapse = " "),
                     target_dir_path)
  system(command, input = rstudioapi::askForPassword("Enter password"))
}

これでうまくいきそうなもんですが、ShinyApp の静的ファイルを www に入れたりモジュールをサブディレクトリに保存していたりという場合が考えられます。 なので指定したサブディレクトリもコピーするという記述も付け加えます。 このとき、フォルダからフォルダへコピーするという動作は共通なので関数化しちゃいます。

copy_files <- function(dir_path, target_dir_path) {
  # なければ作る
  sudo_create_dir_if_not_exists(target_dir_path)
  # ShinyApp のフォルダにある .R ファイルを全て取得
  files <- list.files(dir_path, pattern = "\\.R$", full.names = TRUE)
  # sudo cp コマンドで全てコピー
  command <- sprintf("sudo cp -vfu %s %s", paste(files, collapse = " "),
                     target_dir_path)
  system(command, input = rstudioapi::askForPassword("Enter password"))
}

deploy_shiny_app <- function(dir_path = getwd(), dest = "/srv/shiny-server") {
  # ShinyApp のデプロイ先
  target_dir_path <- file.path(dest, basename(dir_path))
  # コピーの実行
  copy_files(dir_path, target_dir_path)
}

コピーすべき subdir も指定可能にして for 文で回します。

deploy_shiny_app <- function(dir_path = getwd(), dest = "/srv/shiny-server", 
                             subdir = c("www")) {
  # ShinyApp のデプロイ先
  target_dir_path <- file.path(dest, basename(dir_path))
  # コピーの実行
  copy_files(dir_path, target_dir_path)
  
  # サブディレクトリのコピー
  for (subdir_name in subdir) {
    subdir_path <- file.path(dir_path, subdir_name)
    if (dir.exists(subdir_path)) {
      target_subdir_path <- file.path(target_dir_path, subdir_name)
      copy_files(subdir_path, target_subdir_path)
    }
  }
}

これで多分うまくいきます。 最初デプロイ先のフォルダがない場合はフォルダの作成、サブフォルダの作成とパスワードを何度も聞かれてうざいですが、まあしょうがないかなと。

もっと良い方法があれば教えてください。

Enjoy!