packages feed

nix-deploy 1.0.2 → 1.0.3

raw patch · 3 files changed

+82/−46 lines, 3 filesdep +bytestringdep ~optparse-genericdep ~turtle

Dependencies added: bytestring

Dependency ranges changed: optparse-generic, turtle

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+# 1.0.3++## Changed++- Relaxed the upper bound of the `turtle` library dependency to `1.6`+- Relaxed the upper bound of the `optparse-generic` library dependency to `1.4`+ # 1.0.2  ## Changed
nix-deploy.cabal view
@@ -1,5 +1,5 @@ name:                nix-deploy-version:             1.0.2+version:             1.0.3 synopsis:            Deploy Nix-built software to a NixOS machine homepage:            https://github.com/awakesecurity/nix-deploy#readme license:             Apache-2.0@@ -31,11 +31,12 @@   ghc-options:         -Wall   build-depends:                 base                 >= 4.9.0.0  && < 5-              , optparse-generic     >= 1.2.0    && < 1.3+              , bytestring           >= 0.10.8.1 && < 1.0+              , optparse-generic     >= 1.2.0    && < 1.4               , optparse-applicative >= 0.13.0.0 && < 0.15               , neat-interpolation                  < 0.4               , text                 >= 0.7      && < 1.3-              , turtle               >= 1.3.6    && < 1.5+              , turtle               >= 1.3.6    && < 1.6   default-language:    Haskell2010  source-repository head
src/Main.hs view
@@ -22,13 +22,14 @@ import qualified Control.Exception import           Control.Monad import           Control.Monad.IO.Class (MonadIO)+import qualified Data.ByteString.Lazy   as BL import qualified Data.List.NonEmpty     as NonEmpty import           Data.Maybe import           Data.Monoid            ((<>)) import           Data.Text              (Text) import qualified Data.Text              as Text import qualified Data.Text.IO           as Text.IO-import qualified NeatInterpolation      as Neat+import           NeatInterpolation import qualified Options.Applicative    as Options import           Options.Generic import           Prelude                hiding (FilePath)@@ -50,6 +51,7 @@       }     | System       { direction      :: Direction+      , failOnPartialSuccess :: w ::: Bool         <?> "Fail if system activation partially succeeds"       , noSign         :: w ::: Bool               <?> "Don't sign payload (not recommended)"       , path           :: w ::: Maybe FilePath     <?> "Path to deploy"       , systemName     :: w ::: Maybe Line         <?> "Alternative system profile name (default: system)"@@ -153,7 +155,7 @@       let sign = not noSign       when sign $ exchangeKeys targetText -      stderrLines [Neat.text|[+] Copying $pathText|]+      stderrLines [text|[+] Copying $pathText|]       let transfer =             Turtle.procs "nix-copy-closure"               ((if sign then ["--sign"] else []) <>@@ -165,7 +167,7 @@               empty        -- Transfer path to target-      liftIO (Control.Exception.catch transfer (errorHandler [Neat.text|+      liftIO (Control.Exception.catch transfer (errorHandler [text| [x] Failed transferring $pathText $txDir $targetText      1. $pathText does not exist@@ -204,7 +206,7 @@       let sign = not noSign       when sign $ exchangeKeys targetText -      stderrLines [Neat.text|[+] Installing system: $pathText|]+      stderrLines [text|[+] Installing system: $pathText|]        let transfer =             Turtle.procs "nix-copy-closure"@@ -218,7 +220,7 @@        let method = fromMaybe Test switchMethod       let switchSystem =-            Turtle.procs "ssh"+            Turtle.proc "ssh"               [ targetText               , "sudo"               , "/nix/var/nix/profiles/system/bin/switch-to-configuration"@@ -227,7 +229,7 @@               empty        -- Transfer path to target-      liftIO (Control.Exception.catch transfer (errorHandler [Neat.text|+      liftIO (Control.Exception.catch transfer (errorHandler [text| [x] Failed transferring $pathText $txDir $targetText      1. $pathText may not exist, make sure you built it with nix-build first@@ -236,15 +238,30 @@        setProfile direction True profileText pathText -      -- Switch to the new system configuration-      liftIO (Control.Exception.catch switchSystem (errorHandler [Neat.text|-[x] Failed to switch $targetText to $pathText+      let successMsg = [text|[+] Succeeded switching $targetText to $pathText|]+      let partialMsg =  [text|+            $successMsg -    You need `sudo` privileges on the target machine-|]))+                However, some services failed to start or restart.+            |]++      switchSystem >>= \case+        ExitSuccess -> stderrLines successMsg++        -- This is the exit code returned by switch-to-configuration+        -- if the configuration is successfully switched-to (using+        -- `--switch`) but a service failed to start or restart during+        -- the switch. We want to treat this as success but should+        -- tell the user what happened...+        ExitFailure 4 | failOnPartialSuccess -> Turtle.die  partialMsg+                      | otherwise            -> stderrLines partialMsg++        ExitFailure _ ->+          Turtle.die [text|[x] Failed to switch $targetText to $pathText|]+       when (method == Reboot)$ do-        let success = -              stderrLines [Neat.text|[+] $pathText successfully activated, $targetText is rebooting|]+        let success =+              stderrLines [text|[+] $pathText successfully activated, $targetText is rebooting|]         rebootCmd targetText >>= \case           -- This is the exit code returned by `ssh` when the machine closes           -- the connection due to a successful reboot.  We can't really@@ -252,7 +269,7 @@           -- unfortunately, so we have to assume that this meant success           ExitFailure 255 -> success           ExitFailure _   ->-            Turtle.die [Neat.text|[x] Failed to reboot $targetText after activating $pathText at $profileText|]+            Turtle.die [text|[x] Failed to reboot $targetText after activating $pathText at $profileText|]           -- The command should always fail because the remote machine closes           -- connection when rebooting, but we include this case for           -- completeness@@ -270,7 +287,7 @@   let excText0 = Text.justifyRight 4 ' ' <$> Text.lines (Text.pack $ show err)   let excText1 = Text.unlines excText0 -  Turtle.die [Neat.text|+  Turtle.die [text| $msg  Original error was:@@ -280,7 +297,7 @@   rebootCmd :: MonadIO io => Text -> io Turtle.ExitCode-rebootCmd target = Turtle.shell [Neat.text|ssh $target sudo reboot|] empty+rebootCmd target = Turtle.shell [text|ssh $target sudo reboot|] empty  pathFromStdin :: IO Text pathFromStdin = do@@ -314,7 +331,7 @@   let handler0 :: SomeException -> IO ()       handler0 e = do           let exceptionText = Text.pack (show e)-          let msg           = [Neat.text|+          let msg           = [text| [x] Could not ensure that the remote machine has signing keys installed      Debugging tips:@@ -367,7 +384,7 @@               handler1 e = do                   let pathText      = Turtle.format fp path                   let exceptionText = Text.pack (show e)-                  let msg           = [Neat.text|+                  let msg           = [text| [x] Could not download: $pathText      Debugging tips:@@ -396,31 +413,42 @@            liftIO (Control.Exception.handle handler1 download) -          exitCode <- Turtle.shell "sudo -n true 2>/dev/null" empty+          new <- liftIO . BL.readFile . Text.unpack $+            Turtle.format fp localPath -          -- NB: path shouldn't is a FilePath and won't have any-          -- newlines, so this should be okay-          Turtle.err (Turtle.unsafeTextToLine $ Turtle.format ("[+] Installing: "%fp) path)+          old <- liftIO . BL.readFile . Text.unpack $+            Turtle.format fp path -          case exitCode of-              ExitFailure _ -> do-                  Turtle.err ""-                  Turtle.err "    This will prompt you for your `sudo` password"-              _             -> do-                  return ()+          if new == old+              then do+                  let same = Turtle.format ("[+] Unchanged: "%fp) path+                  mapM_ Turtle.err (Turtle.Line.textToLines same)+              else do+                  exitCode <- Turtle.shell "sudo -n true 2>/dev/null" empty -          let install =-                  Turtle.procs "sudo"-                      [ "mv"-                      , Turtle.format fp localPath-                      , Turtle.format fp path-                      ]-                      empty-          let handler2 :: SomeException -> IO ()-              handler2 e = do-                  let pathText      = Turtle.format fp path-                  let exceptionText = Text.pack (show e)-                  let msg           = [Neat.text|+                  -- NB: path shouldn't is a FilePath and won't have any+                  -- newlines, so this should be okay+                  Turtle.err (Turtle.unsafeTextToLine $ Turtle.format ("[+] Installing: "%fp) path)++                  case exitCode of+                      ExitFailure _ -> do+                          Turtle.err ""+                          Turtle.err "    This will prompt you for your `sudo` password"+                      _             -> do+                          return ()++                  let install =+                          Turtle.procs "sudo"+                              [ "mv"+                              , Turtle.format fp localPath+                              , Turtle.format fp path+                              ]+                              empty+                  let handler2 :: SomeException -> IO ()+                      handler2 e = do+                          let pathText      = Turtle.format fp path+                          let exceptionText = Text.pack (show e)+                          let msg           = [text| [x] Could not install: $pathText      Debugging tips:@@ -433,9 +461,9 @@      Original error: $exceptionText |]-                  Turtle.die msg+                          Turtle.die msg -          liftIO (Control.Exception.handle handler2 install)+                  liftIO (Control.Exception.handle handler2 install)    mirror privateKey   mirror publicKey@@ -492,5 +520,5 @@       return command    -- Set or create a profile pointing at the transferred path-  let msg = [Neat.text|[x] Failed setting $profileText to $pathText|]+  let msg = [text|[x] Failed setting $profileText to $pathText|]   liftIO (Control.Exception.handle (errorHandler msg) command)