ec2-unikernel 0.9 → 0.9.1
raw patch · 3 files changed
+37/−11 lines, 3 files
Files
- ec2-unikernel.cabal +1/−1
- src/CommandLine.hs +18/−6
- src/Main.hs +18/−4
ec2-unikernel.cabal view
@@ -1,5 +1,5 @@ name: ec2-unikernel-version: 0.9+version: 0.9.1 synopsis: A handy tool for uploading unikernels to Amazon's EC2. description: This tool uploads unikernels built with the HaLVM, Mirage, or other tools to Amazon's cloud. The unikernel will then
src/CommandLine.hs view
@@ -16,7 +16,7 @@ dazrsAvailabilityZones, dazZoneNames) import Network.AWS.EC2.Types(azZoneName)-import Network.AWS.Types(Error(..), serviceCode)+import Network.AWS.Types(ServiceError, Error(..)) import Options import System.Console.GetOpt(ArgDescr(..), OptDescr(..), ArgOrder(..)) import System.Console.GetOpt(getOpt, usageInfo)@@ -46,7 +46,7 @@ | length sk /= 40 = addError opts "Secret key doesn't look right." | any (not . isSecKeyCh) sk = addError opts "Secret key has weird characters." | otherwise = addOpt opts (set optAwsSecretKey (fromString sk))- where isSecKeyCh c = isAlphaNum c || (c == '/')+ where isSecKeyCh c = isAlphaNum c || (c == '/') || (c == '+') validateS3Bucket :: String -> OptOrErr -> OptOrErr validateS3Bucket b opts@@ -137,15 +137,27 @@ zoneRequest = set dazZoneNames [region] describeAvailabilityZones r <- catch ((runResourceT . runAWS e) (send zoneRequest)) (\ (ServiceError se) ->- do putStr "ERROR: Failed to connect with Amazon. "- putStrLn "This is typically a problem with your keys."- putStrLn (" ("++show(view serviceCode se)++")")- putStrLn (show se)+ do printInitialServiceError se exitWith (ExitFailure 1)) let z = Just (view optS3Zone opts) unless (elemOf (dazrsAvailabilityZones . folded . azZoneName) z r) $ fail' ["Invalid availability zone for region."] return (opts, e)++printInitialServiceError :: ServiceError -> IO ()+printInitialServiceError se =+ do putStrLn "ERROR: Failed to get list of zones from Amazon. This typically"+ putStrLn "is caused by one of two problems:"+ putStrLn ""+ putStrLn " #1: There's something wrong with your keys. Check your"+ putStrLn " arguments, or make sure AWS_ACCESS_KEY and AWS_SECRET_KEY"+ putStrLn " are what you want them to be."+ putStrLn " #2: There's something wrong with your computer's clock. Run"+ putStrLn " whatever software you have to synchronize your clock, and"+ putStrLn " try again."+ putStrLn ""+ putStrLn "Just in case it's useful, here's the raw error:"+ putStrLn (show se) adjustTargetName :: UTCTime -> Options -> Options adjustTargetName now opts
src/Main.hs view
@@ -64,6 +64,7 @@ import System.IO.Temp(withSystemTempDirectory) import System.Posix.Files(fileSize, getFileStatus) import System.Process(callProcess)+import System.Timeout(timeout) main :: IO () main =@@ -116,7 +117,8 @@ buildDisk :: Options -> IO FilePath buildDisk opts = withSystemTempDirectory "ec2-unikernel" $ \ path ->- do sizeb <- fileSize `fmap` getFileStatus (view optKernel opts)+ do logm "DISK" ("Building disk.")+ sizeb <- fileSize `fmap` getFileStatus (view optKernel opts) let sizem = ceiling (fromInteger (fromIntegral sizeb) / onemeg) + 1 writeFile (path </> "menu.lst") (grubMenu opts) writeFile (path </> "guestfish.scr")@@ -125,6 +127,7 @@ callProcess "guestfish" ["-f", path </> "guestfish.scr"] let targetFile = unpack (toText (view optTargetKey opts)) copyFile (path </> "disk.raw") targetFile+ logm "DISK" ("Built disk " ++ targetFile) return targetFile grubMenu :: Options -> String@@ -190,13 +193,15 @@ uploadFile :: Options -> Env -> FilePath -> IO () uploadFile opts e filename =- do rsp <- awsSend e (createMultipartUpload bucket key)+ do logm "UPLOAD" "Creating upload."+ rsp <- awsSend e (createMultipartUpload bucket key) case (view cmursUploadId rsp, view cmursResponseStatus rsp) of (Nothing, code) -> putStrLn ("ERROR: Upload initialization failed with code: "++show code) (Just upId, _) -> do bytes <- L.readFile filename sizeb <- fileSize `fmap` getFileStatus filename+ logm "UPLOAD" "Starting upload." runUpload upId 0 (fromIntegral sizeb) bytes 1 [] where bucket = view optS3Bucket opts@@ -225,7 +230,8 @@ do let (chunkBS, rest) = L.splitAt amazonMinimimPartSizeInBytes bytes chunk = Hashed (toHashed chunkBS) sentSize' = sentSize + contentLength chunk- rsp <- awsSend e (uploadPart bucket key partNo upId chunk)+ req = uploadPart bucket key partNo upId chunk+ rsp <- awsSend e req case (view uprsETag rsp, view uprsResponseStatus rsp) of (Nothing, code) -> do putStrLn ("ERROR: Upload failed with code: " ++ show code)@@ -338,7 +344,15 @@ logm category message = putStrLn (category ++ ": " ++ message) awsSend :: AWSRequest r => Env -> r -> IO (Rs r)-awsSend e x = runResourceT (runAWS e (send x))+awsSend env request = go 5 request+ where+ go :: AWSRequest r => Int -> r -> IO (Rs r)+ go 0 _ = fail "Amazon request failed."+ go x v =+ do mrsp <- timeout (15 * 1000000) (runResourceT (runAWS env (send v)))+ case mrsp of+ Nothing -> putStrLn "Retrying." >> go (x - 1) v+ Just rsp -> return rsp show' :: Maybe Text -> String show' Nothing = ""