├── Setup.hs ├── .gitignore ├── apotiki.conf.example ├── Dockerfile ├── System └── Apotiki │ ├── Utils.hs │ ├── FileInfo.hs │ ├── Logger.hs │ ├── Tar.hs │ ├── Debian │ ├── Control.hs │ ├── Package.hs │ └── Release.hs │ ├── Signature.hs │ ├── Ar.hs │ ├── Config.hs │ └── Templates.hs ├── LICENSE ├── apotiki.cabal ├── apotiki.hs └── README.md /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /tmp 2 | /dist 3 | /.cabal-sandbox 4 | cabal.sandbox.config 5 | -------------------------------------------------------------------------------- /apotiki.conf.example: -------------------------------------------------------------------------------- 1 | architectures: i386 amd64 2 | component: main 3 | release: precise 4 | label: Apotiki 5 | origin: Apotiki 6 | repo: /srv/apotiki 7 | logfile: /var/log/apotiki.log 8 | pgp-key: 9 | -----BEGIN PGP PRIVATE KEY BLOCK----- 10 | Version: GnuPG v2.0.22 (GNU/Linux) 11 | 12 | [...] 13 | -----END PGP PRIVATE KEY BLOCK----- 14 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM jahkeup/ubuntu:saucy 2 | RUN apt-get update 3 | RUN apt-get install -y build-essential git cabal-install zlib1g-dev libbz2-dev 4 | RUN cabal update 5 | RUN cabal install apotiki 6 | RUN mkdir /srv/repo 7 | ADD apotiki.conf.example /etc/apotiki.conf 8 | ADD key.pgp /srv/repo/key.pgp 9 | EXPOSE 8000 10 | ENTRYPOINT [".cabal/bin/apotiki", "web"] -------------------------------------------------------------------------------- /System/Apotiki/Utils.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Utils (strip) where 2 | import Data.List 3 | 4 | -- inspired by MissingH 5 | 6 | wschars :: String 7 | wschars = " \t\r\n" 8 | 9 | is_white :: Char -> Bool 10 | is_white c = isInfixOf [c] wschars 11 | 12 | lstrip :: String -> String 13 | lstrip s = dropWhile is_white s 14 | 15 | rstrip :: String -> String 16 | rstrip = reverse . lstrip . reverse 17 | 18 | strip :: String -> String 19 | strip = lstrip . rstrip 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2014 Pierre-Yves Ritschard 2 | 3 | Permission to use, copy, modify, and distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /System/Apotiki/FileInfo.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.FileInfo (sha256sum, sha1sum, md5sum, fileinfo) where 2 | import qualified Data.ByteString as B 3 | import qualified Crypto.Hash.SHA256 as SHA256 4 | import qualified Crypto.Hash.SHA1 as SHA1 5 | import qualified Crypto.Hash.MD5 as MD5 6 | import qualified Text.Printf as P 7 | import qualified Data.Map as M 8 | 9 | gensum input hashfn = B.unpack (hashfn input) >>= P.printf "%02x" 10 | sha256sum input = gensum input SHA256.hash 11 | sha1sum input = gensum input SHA1.hash 12 | md5sum input = gensum input MD5.hash 13 | fileinfo input = M.fromList [("Size", show $ B.length input), 14 | ("MD5sum", md5sum input), 15 | ("SHA1", sha1sum input), 16 | ("SHA256", sha256sum input)] 17 | -------------------------------------------------------------------------------- /System/Apotiki/Logger.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Logger (log_start, log_info, LogChan) where 2 | import System.IO (openFile, hPutStrLn, hFlush, hClose, 3 | IOMode (AppendMode), Handle) 4 | import Control.Concurrent (forkIO) 5 | import Control.Monad (void, forever) 6 | import Control.Monad.STM (atomically) 7 | import Control.Concurrent.STM.TChan (writeTChan, readTChan, newTChanIO, TChan) 8 | 9 | -- Simplistic logging module 10 | 11 | type LogChan = TChan String 12 | 13 | put_line :: String -> String -> IO () 14 | put_line path line = do 15 | fd <- openFile path AppendMode 16 | hPutStrLn fd line 17 | hFlush fd 18 | hClose fd 19 | 20 | log_line :: TChan String -> String -> IO () 21 | log_line chan path = do 22 | line <- atomically $ readTChan chan 23 | if path == "STDOUT" then (putStrLn line) else (put_line path line) 24 | 25 | log_start :: String -> IO (TChan String) 26 | log_start path = do 27 | chan <- newTChanIO 28 | void $ forkIO $ forever $ log_line chan path 29 | return chan 30 | 31 | log_info :: TChan String -> String -> IO () 32 | log_info chan msg = do 33 | let info_msg = "[info] " ++ msg 34 | atomically $ writeTChan chan info_msg 35 | -------------------------------------------------------------------------------- /System/Apotiki/Tar.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Tar (getControl, getStrictControl) where 2 | import Data.List 3 | import qualified Data.Map as M 4 | import qualified Codec.Archive.Tar as Tar 5 | import qualified Data.ByteString as BS 6 | import qualified Data.ByteString.Lazy as B 7 | import qualified Data.ByteString.Lazy.Char8 as BC 8 | import qualified Codec.Compression.GZip as Z 9 | 10 | tarEntryList :: Tar.Entries Tar.FormatError -> [Tar.Entry] -> [Tar.Entry] 11 | tarEntryList entries outlist = 12 | case entries of 13 | Tar.Next entry (more) -> (tarEntryList more (entry:outlist)) 14 | Tar.Done -> outlist 15 | Tar.Fail e -> error (show e) 16 | 17 | tarEntryPayload :: Tar.EntryContent -> String 18 | tarEntryPayload (Tar.NormalFile payload size) = BC.unpack payload 19 | 20 | getStrictControl :: BS.ByteString -> String 21 | getStrictControl content = 22 | getControl $ B.fromChunks [content] 23 | 24 | getControl :: B.ByteString -> String 25 | getControl content = 26 | tarEntryPayload $ Tar.entryContent entry 27 | where unzipped = Z.decompress content 28 | entries = tarEntryList (Tar.read unzipped) [] 29 | entry = case find ((== "./control") . Tar.entryPath) entries of 30 | Just entry -> entry 31 | Nothing -> error (show $ map Tar.entryPath entries) 32 | -------------------------------------------------------------------------------- /System/Apotiki/Debian/Control.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Debian.Control (DebInfo, ctlFromData) where 2 | import System.Apotiki.Utils 3 | import Data.Attoparsec.Combinator (manyTill, many1) 4 | import Data.ByteString.Char8 (pack, unpack) 5 | import Data.List (intersperse) 6 | import qualified Data.Map as M 7 | import qualified Data.ByteString as B 8 | import qualified Data.Attoparsec.ByteString as P 9 | 10 | type DebInfo = M.Map String String 11 | 12 | ctlValParser :: P.Parser String 13 | ctlValParser = do 14 | P.string $ pack " " 15 | val <- unpack `fmap` P.takeWhile (P.notInClass "\n") 16 | P.string $ pack "\n" 17 | return val 18 | 19 | ctlFlatDescParser = (concat . intersperse "\n ") `fmap` many1 ctlValParser 20 | 21 | ctlEntryParser :: P.Parser (String, String) 22 | ctlEntryParser = do 23 | k <- unpack `fmap` P.takeWhile (P.notInClass ":") 24 | P.string $ pack ":" 25 | v <- if (k == "Description") then ctlFlatDescParser else ctlValParser 26 | return (k, strip v) 27 | 28 | ctlParser :: P.Parser DebInfo 29 | ctlParser = M.fromList `fmap` many1 ctlEntryParser 30 | 31 | ctlFromData :: B.ByteString -> Either String DebInfo 32 | ctlFromData input = P.parseOnly ctlParser input 33 | 34 | ctlFromFile :: String -> IO (Either String DebInfo) 35 | ctlFromFile path = do 36 | content <- B.readFile path 37 | return (ctlFromData content) 38 | -------------------------------------------------------------------------------- /System/Apotiki/Signature.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module System.Apotiki.Signature (sign_msg, get_key) where 3 | import System.Time (getClockTime, ClockTime(..)) 4 | import Crypto.Random 5 | import Data.OpenPGP 6 | import Data.String 7 | import qualified Data.Binary as Binary 8 | import qualified Data.OpenPGP.CryptoAPI as PGP 9 | import qualified Data.ByteString.Lazy as B 10 | import qualified Data.ByteString as BS 11 | import qualified Data.ByteString.Char8 as BC 12 | import Codec.Encryption.OpenPGP.ASCIIArmor as Armor 13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types as Armor 14 | 15 | get_key keypath = do 16 | let payload = BC.pack keypath 17 | let Right decoded_key = Armor.decode payload 18 | let ((Armor _ _ bskey):_) = decoded_key 19 | let key = Binary.decode bskey 20 | TOD tod _ <- getClockTime 21 | rng <- newGenIO :: IO SystemRandom 22 | let time = (fromIntegral tod :: Integer) 23 | return (key, (time, rng)) 24 | 25 | sign_msg :: (CryptoRandomGen g) => Message -> Integer -> g -> BS.ByteString -> BS.ByteString 26 | sign_msg keys time rng payload = 27 | Armor.encode [armor] where 28 | wtime = (fromIntegral time :: Binary.Word32) 29 | lazy_payload = B.fromChunks [payload] 30 | pgp_payload = LiteralDataPacket 'b' "" wtime lazy_payload 31 | input = (DataSignature pgp_payload []) 32 | (DataSignature _ [sig], _) = PGP.sign keys input SHA256 [] time rng 33 | options = [("Version", "OpenPrivacy 0.99"), ("Hash", "SHA256")] 34 | encoded_sig = Binary.encode sig 35 | armor = Armor.Armor Armor.ArmorSignature options encoded_sig 36 | -------------------------------------------------------------------------------- /System/Apotiki/Debian/Package.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Debian.Package where 2 | import System.Apotiki.Ar 3 | import System.Apotiki.Tar 4 | import System.Apotiki.FileInfo 5 | import System.Apotiki.Utils 6 | import System.Apotiki.Config 7 | import System.Apotiki.Logger 8 | import System.Apotiki.Debian.Control 9 | import Data.List 10 | import System.Directory 11 | import Data.ByteString.Char8 (pack, unpack) 12 | import qualified Data.ByteString as B 13 | import qualified Data.Map as M 14 | 15 | writeToPool :: LogChan -> String -> (DebInfo, B.ByteString) -> IO () 16 | writeToPool logger repodir (info, payload) = do 17 | let path = info M.! "Filename" 18 | let dir_path = reverse $ snd $ break (== '/') $ reverse path 19 | log_info logger $ "found filename: " ++ path 20 | createDirectoryIfMissing True (repodir ++ "/" ++ dir_path) 21 | B.writeFile (repodir ++ "/" ++ path) payload 22 | B.writeFile (repodir ++ "/" ++ dir_path ++ "control") $ pack (show info) 23 | 24 | toDebInfo :: String -> DebInfo 25 | toDebInfo input = output where Right output = ctlFromData $ pack $ input 26 | 27 | debInfo :: ApotikiConfig -> B.ByteString -> DebInfo 28 | debInfo config payload = 29 | M.union (fileinfo payload) (M.insert "Filename" path debinfo) where 30 | Right archive = (arFromData payload) 31 | ArEntry {entryData = entry} = archive M.! "control.tar.gz" 32 | debinfo = toDebInfo $ getStrictControl entry 33 | arch = case M.lookup "Architecture" debinfo of 34 | Nothing -> "NOARCH" 35 | Just x -> x 36 | pkg = case M.lookup "Package" debinfo of 37 | Nothing -> "NOPKG" 38 | Just x -> x 39 | pooldir = configPoolDir config 40 | path = "pool/" ++ arch ++ "/" ++ pkg ++ "/" ++ pkg ++ ".deb" 41 | -------------------------------------------------------------------------------- /System/Apotiki/Ar.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Ar (arFromData, arFromFile, ArEntry (..)) where 2 | import Data.Attoparsec.Combinator (manyTill) 3 | import Data.ByteString.Char8 (pack, unpack) 4 | import qualified Data.Map as M 5 | import qualified Data.ByteString as B 6 | import qualified Data.Attoparsec.ByteString as P 7 | 8 | armag = "!\n" -- magic header 9 | arfmag = "`\n" -- magic pad 10 | 11 | data ArEntry = ArEntry { -- A file entry in an ar file 12 | entryDate :: Int, 13 | entryGid :: Int, 14 | entryUid :: Int, 15 | entryMode :: Int, 16 | entrySize :: Int, 17 | entryData :: B.ByteString 18 | } deriving Show 19 | 20 | type ArMapEntry = (String, ArEntry) 21 | type ArMap = M.Map String ArEntry 22 | 23 | arEntryParser :: P.Parser ArMapEntry 24 | arEntryParser = do 25 | let not_space = (\c -> (c /= '/') && (c /= ' ')) 26 | name <- (takeWhile not_space . unpack) `fmap` P.take 16 27 | date <- (read . unpack) `fmap` P.take 12 28 | gid <- (read . unpack) `fmap` P.take 6 29 | uid <- (read . unpack) `fmap` P.take 6 30 | mode <- (read . unpack) `fmap` P.take 8 31 | size <- (read . unpack) `fmap` P.take 10 32 | magic <- P.string $ pack arfmag 33 | payload <- P.take size 34 | padding <- if size `mod` 2 == 1 then P.string $ pack "\n" else P.take 0 35 | return (name, ArEntry date gid uid mode size payload) 36 | 37 | arParser :: P.Parser ArMap 38 | arParser = do 39 | magic <- P.string $ pack armag 40 | entries <- manyTill arEntryParser P.endOfInput 41 | return (M.fromList entries) 42 | 43 | arFromData :: B.ByteString -> Either String ArMap 44 | arFromData input = P.parseOnly arParser input 45 | 46 | arFromFile :: String -> IO (Either String ArMap) 47 | arFromFile path = do 48 | content <- B.readFile path 49 | return (arFromData content) 50 | -------------------------------------------------------------------------------- /apotiki.cabal: -------------------------------------------------------------------------------- 1 | -- Initial apotiki.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: apotiki 5 | version: 0.5.2 6 | synopsis: a faster debian repository 7 | description: 8 | apotiki generates debian repositories fast. its goal is 9 | to be a great companion to fpm and jenkins. 10 | . 11 | apotiki operates with the following features and constraints: 12 | . 13 | - Supports a single debian release 14 | . 15 | - Supports a single debian component 16 | . 17 | - Supports an arbitrary number of architectures which need to be preprovisionned 18 | . 19 | - Requires a valid PGP private key for signing 20 | 21 | -- description: 22 | homepage: https://github.com/pyr/apotiki 23 | license: MIT 24 | license-file: LICENSE 25 | author: Pierre-Yves Ritschard 26 | maintainer: pyr@spootnik.org 27 | -- copyright: 28 | category: System 29 | build-type: Simple 30 | -- extra-source-files: 31 | cabal-version: >=1.10 32 | extra-source-files: README.md 33 | System/Apotiki/Debian/*.hs 34 | System/Apotiki/*.hs 35 | 36 | library 37 | exposed-modules: System.Apotiki.Ar 38 | System.Apotiki.Debian.Package 39 | System.Apotiki.Debian.Release 40 | build-depends: base >=4.6 && <4.7, bytestring >= 0.10.0.2, 41 | containers >= 0.5.0.0, cryptohash >= 0.9.1, 42 | zlib >= 0.5.4.1, tar >= 0.4.0.1, aeson >= 0.6.2.1, 43 | attoparsec >= 0.10.4.0, directory >= 1.2.0.1, 44 | openpgp-asciiarmor >= 0.1, openpgp-crypto-api >= 0.6.3, 45 | binary >= 0.7.1.0, openpgp >= 0.6.1, strict >= 0.3.2, 46 | crypto-api == 0.12.2.2, old-time >= 1.1.0.1, 47 | scotty >= 0.6.2, wai-extra >= 2.0.3.1, text >= 1.0.0.1, 48 | http-types >= 0.8.3, transformers >= 0.3.0.0, 49 | transformers >= 0.3.0.0, wai-middleware-static >= 0.4.0.2, 50 | stm >= 2.4.2, warp >= 2.0.2, data-default >= 0.5.3 51 | default-language: Haskell2010 52 | -- other-modules: 53 | -- other-extensions: 54 | 55 | executable apotiki 56 | main-is: apotiki.hs 57 | ghc-options: -threaded 58 | -- other-modules: 59 | -- other-extensions: 60 | build-depends: base >=4.6 && <4.7, bytestring >= 0.10.0.2, 61 | containers >= 0.5.0.0, cryptohash >= 0.9.1, 62 | zlib >= 0.5.4.1, tar >= 0.4.0.1, aeson >= 0.6.2.1, 63 | attoparsec >= 0.10.4.0, directory >= 1.2.0.1, 64 | openpgp-asciiarmor >= 0.1, openpgp-crypto-api >= 0.6.3, 65 | binary >= 0.7.1.0, openpgp >= 0.6.1, strict >= 0.3.2, 66 | crypto-api == 0.12.2.2, old-time >= 1.1.0.1, 67 | scotty >= 0.6.2, wai-extra >= 2.0.3.1, text >= 1.0.0.1, 68 | http-types >= 0.8.3, transformers >= 0.3.0.0, 69 | transformers >= 0.3.0.0, wai-middleware-static >= 0.4.0.2, 70 | stm >= 2.4.2, warp >= 2.0.2, data-default >= 0.5.3 71 | 72 | -- hs-source-dirs: 73 | default-language: Haskell2010 74 | -------------------------------------------------------------------------------- /apotiki.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | import System.Apotiki.Debian.Package 5 | import System.Apotiki.Debian.Release 6 | import System.Apotiki.Config 7 | import System.Apotiki.Templates 8 | import System.Apotiki.Logger 9 | import Data.Map (keys) 10 | import System.Environment 11 | import System.Directory 12 | import Control.Exception 13 | 14 | import Network.HTTP.Types.Status 15 | import Web.Scotty 16 | import Data.Text (pack) 17 | import Data.Text.Lazy (unpack) 18 | import Data.ByteString.Lazy (toChunks) 19 | import Network.Wai.Middleware.RequestLogger 20 | import Network.Wai.Parse 21 | 22 | import Data.Aeson (object, (.=)) 23 | import Control.Monad (guard) 24 | import System.IO.Error (isDoesNotExistError) 25 | import Control.Monad.IO.Class (liftIO) 26 | import qualified Data.ByteString as B 27 | import qualified Data.Text.Lazy as T 28 | 29 | import Network.Wai.Middleware.Static 30 | 31 | setupRepo config = do 32 | createDirectoryIfMissing True (configDistDir config) 33 | createDirectoryIfMissing True (configPoolDir config) 34 | 35 | main :: IO () 36 | main = do 37 | -- first fetch our config 38 | result <- tryJust (guard . isDoesNotExistError) $ getEnv "APOTIKI_CONFIG" 39 | let confpath = case result of 40 | Left e -> "/etc/apotiki.conf" 41 | Right val -> val 42 | config <- parseFile confpath 43 | logger <- log_start (configLogPath config) 44 | log_info logger "starting up" 45 | args <- getArgs 46 | runCommand logger config args 47 | 48 | runCommand logger config [] = runCommand logger config ["help"] 49 | 50 | runCommand logger config ("help":debfiles) = do 51 | putStrLn "usage: apotiki {web, insert} [packages]" 52 | 53 | runCommand logger config ("web":_) = do 54 | setupRepo config 55 | scottyOpts (configWai config) $ do 56 | get "/apotiki.js" $ do 57 | html $ T.pack jsApp 58 | get "/index.html" $ do 59 | html $ T.pack indexHtml 60 | get "/listing.html" $ do 61 | html $ T.pack listingHtml 62 | get "/details.html" $ do 63 | html $ T.pack detailsHtml 64 | get "/post.html" $ do 65 | html $ T.pack postHtml 66 | get "/" $ do 67 | redirect "/index.html" 68 | get "/repo" $ do 69 | repo <- liftIO (releaseJSON $ configPoolDir config) 70 | json repo 71 | post "/repo" $ do 72 | indata <- files 73 | let debfiles = [B.concat $ toChunks $ fileContent fi | (_,fi) <- indata] 74 | liftIO $ insertPackages logger config debfiles 75 | redirect "/index.html" 76 | 77 | runCommand logger config ("insert":filenames) = do 78 | setupRepo config 79 | debfiles <- mapM B.readFile filenames 80 | insertPackages logger config debfiles 81 | 82 | insertPackages logger config debfiles = do 83 | -- now load our view of the world 84 | old_release <- loadRelease $ configPoolDir config 85 | log_info logger $ "got previous release: " ++ (show $ length $ keys old_release) 86 | 87 | let debinfo = map (debInfo config) debfiles 88 | let archs = configArchs config 89 | let pending_release = releaseFrom archs debinfo 90 | 91 | log_info logger $ "got pending release: " ++ (show $ length $ keys pending_release) 92 | 93 | -- merge old and new release 94 | let release = updateRelease archs old_release pending_release 95 | 96 | writeRelease logger config release 97 | 98 | -- write package to their destination 99 | mapM_ (writeToPool logger $ configRepoDir config) $ zip debinfo debfiles 100 | 101 | log_info logger "done updating repository" 102 | -------------------------------------------------------------------------------- /System/Apotiki/Config.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Config where 2 | import System.Apotiki.Utils 3 | import Data.Attoparsec.Combinator (manyTill, many1) 4 | import Data.ByteString.Char8 (pack, unpack) 5 | import Data.List (intersperse) 6 | import Network.Wai.Handler.Warp(HostPreference(..), settingsHost, settingsPort) 7 | import qualified Data.Map as M 8 | import qualified Data.ByteString as B 9 | import qualified Data.Attoparsec.ByteString as P 10 | 11 | import Web.Scotty 12 | import Data.Default (def) 13 | import Network.Wai.Handler.Warp (settingsPort) 14 | 15 | data ApotikiConfig = ApotikiConfig { 16 | keyPath :: String, 17 | architectures :: [String], 18 | component :: String, 19 | release :: String, 20 | label :: String, 21 | origin :: String, 22 | repoDir :: String, 23 | logPath :: String, 24 | waiOpts :: Options 25 | } 26 | 27 | configKeyPath ApotikiConfig { keyPath = x } = x 28 | configArchs ApotikiConfig { architectures = x } = x 29 | configComponent ApotikiConfig { component = x } = x 30 | configRelease ApotikiConfig { release = x } = x 31 | configPoolDir ApotikiConfig { repoDir = x } = x ++ "/pool" 32 | configDistDir ApotikiConfig { repoDir = x } = x ++ "/dists" 33 | configRepoDir ApotikiConfig { repoDir = x } = x 34 | configOrigin ApotikiConfig { origin = x } = x 35 | configLabel ApotikiConfig { label = x } = x 36 | configLogPath ApotikiConfig { logPath = x } = x 37 | configWai ApotikiConfig { waiOpts = x } = x 38 | 39 | type ConfigMap = M.Map String String 40 | 41 | keyLineParser :: P.Parser String 42 | keyLineParser = do 43 | P.skipWhile (P.inClass " \t") 44 | val <- unpack `fmap` P.takeWhile (P.notInClass "\n") 45 | P.string $ pack "\n" 46 | return $ strip val 47 | 48 | keyParser :: P.Parser String 49 | keyParser = do 50 | P.skipWhile (P.notInClass "\n") 51 | P.string $ pack "\n" 52 | key <- (concat . intersperse "\n") `fmap` many1 keyLineParser 53 | return $ key ++ "\n" 54 | 55 | valParser :: P.Parser String 56 | valParser = do 57 | P.skipWhile (P.inClass "\t ") 58 | v <- unpack `fmap` P.takeWhile (P.notInClass "\n") 59 | P.string $ pack "\n" 60 | return $ strip v 61 | 62 | directiveParser :: P.Parser (String, String) 63 | directiveParser = do 64 | k <- unpack `fmap` P.takeWhile (P.notInClass ":") 65 | P.string $ pack ":" 66 | P.skipWhile (P.inClass " \t") 67 | v <- if k == "pgp-key" then keyParser else valParser 68 | return (strip k, v) 69 | 70 | configParser :: P.Parser ConfigMap 71 | configParser = M.fromList `fmap` many1 directiveParser 72 | 73 | parseData :: B.ByteString -> ApotikiConfig 74 | parseData input = transformConfigMap config_map where 75 | parsed = P.parseOnly configParser input 76 | Right config_map = parsed 77 | 78 | parseFile :: String -> IO (ApotikiConfig) 79 | parseFile path = do 80 | content <- B.readFile path 81 | return (parseData content) 82 | 83 | parseList :: String -> [String] 84 | parseList input = if input == "" then [] else (h:(parseList $ strip t)) where 85 | (h,t) = break (== ' ') input 86 | 87 | get_wai_port cfg = case (M.lookup "port" cfg) of 88 | Just x -> (read x :: Int) 89 | Nothing -> 8000 90 | 91 | get_wai_host cfg = case (M.lookup "host" cfg) of 92 | Nothing -> HostAny 93 | Just x -> Host x 94 | 95 | get_wai_opts cfg = 96 | def { verbose = 0, 97 | settings = (settings def) { settingsPort = get_wai_port cfg, 98 | settingsHost = get_wai_host cfg 99 | } 100 | } 101 | 102 | transformConfigMap :: ConfigMap -> ApotikiConfig 103 | transformConfigMap cfg = 104 | ApotikiConfig { 105 | keyPath = cfg M.! "pgp-key", 106 | release = cfg M.! "release", 107 | component = cfg M.! "component", 108 | label = cfg M.! "label", 109 | origin = cfg M.! "origin", 110 | repoDir = cfg M.! "repo", 111 | logPath = cfg M.! "logfile", 112 | architectures = parseList $ cfg M.! "architectures", 113 | waiOpts = get_wai_opts cfg 114 | } 115 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | apotiki: a faster debian repository 2 | =================================== 3 | 4 | ![apotiki](http://i.imgur.com/3Jmupwb.jpg) 5 | 6 | ([image source](http://commons.wikimedia.org/wiki/File:A_view_of_the_map_repository_at_The_National_Archives.jpg)) 7 | 8 | apotiki generates debian repositories fast. its goal is 9 | to be a great companion to [fpm](https://github.com/jordansissel/fpm) and 10 | [jenkins](http://jenkins-ci.org). 11 | 12 | apotiki operates with the following features and constraints: 13 | 14 | * Supports a single debian release 15 | * Supports a single debian component 16 | * Supports an arbitrary number of architectures which need to be preprovisionned 17 | * Requires a valid PGP private key for signing 18 | 19 | ## The Story 20 | 21 | You operate a production environment and rely on software that is more recent than is 22 | available on a standard Debian or Ubuntu distribution ? Apotiki helps you distribute 23 | software by creating a separate debian repository which you can add to your apt sources. 24 | 25 | Turns out there's already software available for this, such as [freight](https://github.com/rcrowley/freight), 26 | apotiki's angle is to work very fast for the most common use case. 27 | 28 | ## Companion software 29 | 30 | [fpm](https://github.com/jordansissel/fpm) is a great tool to build Debian packages with. 31 | It can produce packages from directories, gems, npm or pip libraries. 32 | 33 | [jenkins](http://jenkins-ci.org) or [travis-ci](http://travis-ci.com) can produce artifacts by running 34 | scripts. 35 | 36 | ## Using 37 | 38 | apotiki has two modes of operation, try not to mix the two too much: 39 | 40 | * `apotiki insert`: pushes a list of packages, given on the command line to the repo 41 | * `apotiki web`: start up a web service on port 8000 to display the repository and accept new packages 42 | 43 | Running apotiki with no arguments or `help` will tell you a bit about usage. 44 | 45 | If you wish to submit packages to the repository with curl here is the relevant command line 46 | assuming your package file is `package-foo.deb` 47 | 48 | ```bash 49 | curl -X POST -F "package=@/path/to/package-foo.deb" http://repo-host:8000/repo 50 | ``` 51 | 52 | ## Installing 53 | 54 | Apotiki is a haskell program and relies on both the ghc compiler and 55 | cabal. They are probably already available in your platform of choice. 56 | for instance, on debian based systems, just run 57 | `apt-get install cabal-install`. 58 | 59 | Once cabal is installed, just run: 60 | 61 | ```bash 62 | cabal update 63 | cabal install apotiki 64 | ``` 65 | 66 | ## Building 67 | 68 | Alternatively, you can build apotiki with docker. Just run: 69 | 70 | ``` 71 | sudo docker build . 72 | ``` 73 | 74 | The resulting container will have the built cabal executable. 75 | 76 | 77 | ## Configuring 78 | 79 | The configuration file format resembles is a simple column 80 | separated format, no comment lines are allowed and all configuration 81 | keys are expected to be downcased. 82 | 83 | ``` 84 | host: 127.0.0.1 85 | port: 4000 86 | architectures: i386 amd64 87 | component: main 88 | release: precise 89 | label: Apotiki 90 | origin: Apotiki 91 | repo: /srv/apotiki 92 | logfile: STDOUT 93 | pgp-key: 94 | -----BEGIN PGP PRIVATE KEY BLOCK----- 95 | Version: GnuPG v2.0.22 (GNU/Linux) 96 | 97 | [base64 nonsense...] 98 | -----END PGP PRIVATE KEY BLOCK----- 99 | 100 | ``` 101 | 102 | * `host`: IP to listen on for web service 103 | * `port`: port to listen on for input web service 104 | * `architectures`: list of supported architectures in your repo 105 | * `component`: name of the release component, a single component is supported for now 106 | * `release`: name of the debian release you wish to expose 107 | * `label` and `origin`: Debian repository format details, see https://wiki.debian.org/RepositoryFormat#Label 108 | * `repo`: directory where the repo will live 109 | * `logfile`: either *STDOUT* for console logging or a path to log to 110 | * `pgp-key`: ascii-armored export of the PGP key to sign the repo with 111 | 112 | The PGP private key you wish to use can be exported with: 113 | 114 | ``` 115 | gpg -a --export-secret-keys repository-key@your.domain 116 | ``` 117 | 118 | The config file path can be controlled with the `APOTIKI_CONFIG` environment 119 | variable. 120 | 121 | ## Caveats 122 | 123 | Error handling is suboptimal to say the least. we'll get there. 124 | -------------------------------------------------------------------------------- /System/Apotiki/Debian/Release.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Debian.Release where 2 | import System.Apotiki.Debian.Package 3 | import System.Apotiki.Debian.Control 4 | import System.Apotiki.FileInfo 5 | import System.Apotiki.Config 6 | import System.Apotiki.Logger 7 | import System.Apotiki.Signature 8 | import System.Directory 9 | import System.IO 10 | import Data.List 11 | import Data.Function 12 | import Data.ByteString.Char8 (pack,unpack) 13 | import Data.Aeson 14 | import qualified System.IO.Strict as SIO 15 | import qualified Codec.Compression.GZip as Z 16 | import qualified Data.ByteString as B 17 | import qualified Data.ByteString.Lazy as BL 18 | import qualified Data.Map as M 19 | 20 | type ArchRelease = M.Map String DebInfo 21 | type Release = M.Map String ArchRelease 22 | 23 | flatinfo fileinfo = [fileinfo M.! "Size", fileinfo M.! "MD5sum", 24 | fileinfo M.! "SHA1", fileinfo M.! "SHA256"] 25 | 26 | unrollEntry (k,v) = k ++ ": " ++ v 27 | unrollMap input = concat $ intersperse "\n" $ map unrollEntry $ M.assocs input 28 | 29 | unroll :: [DebInfo] -> String 30 | unroll input = (concat $ intersperse "\n\n" $ map unrollMap input) ++ "\n" 31 | 32 | pkgControl pooldir arch pkg = do 33 | let path = pooldir ++ "/" ++ arch ++ "/" ++ pkg ++ "/control" 34 | fd <- openFile path ReadMode 35 | control_data <- SIO.hGetContents fd 36 | let output = (read control_data :: DebInfo) 37 | hClose fd 38 | return output 39 | 40 | archRelease pooldir arch = do 41 | let path = pooldir ++ "/" ++ arch 42 | entries <- getDirectoryContents path 43 | let pkgs = filter ((/= '.') . head) entries 44 | controls <- mapM (pkgControl pooldir arch) pkgs 45 | return (M.fromList $ zip pkgs controls) 46 | 47 | loadRelease :: String -> IO (Release) 48 | loadRelease pooldir = do 49 | entries <- getDirectoryContents pooldir 50 | let archs = filter ((/= '.') . head) entries 51 | arch_releases <- mapM (archRelease pooldir) archs 52 | return (M.fromList $ zip archs arch_releases) 53 | 54 | releaseJSON pooldir = do 55 | release <- loadRelease pooldir 56 | let encoded = release 57 | return encoded 58 | 59 | same_arch x y = (fst x) == (fst y) 60 | 61 | releaseByArch archs debinfo = 62 | if arch == "all" then 63 | zip archs (repeat debinfo) 64 | else 65 | [(arch, debinfo)] 66 | where arch = debinfo M.! "Architecture" 67 | 68 | releaseDescr (_,deb) = (package, deb) where 69 | package = deb M.! "Package" 70 | 71 | releaseMap debs = (fst $ head $ debs, 72 | M.fromList $ map releaseDescr debs) 73 | 74 | releaseFrom archs debs = M.fromList release_map where 75 | all_debs = concatMap (releaseByArch archs) debs 76 | sorted = sortBy (compare `on` fst) all_debs 77 | by_arch = groupBy same_arch sorted 78 | release_map = map releaseMap by_arch 79 | 80 | mergeRelease new old arch = 81 | M.union new_arch old_arch where 82 | new_arch = case (M.lookup arch new) of 83 | Nothing -> M.fromList [] 84 | Just x -> x 85 | old_arch = case (M.lookup arch old) of 86 | Nothing -> M.fromList [] 87 | Just x -> x 88 | 89 | updateRelease archs old new = M.fromList (zip archs updated) where 90 | updated = map (mergeRelease new old) archs 91 | 92 | getPkg :: ApotikiConfig -> (String, ArchRelease) -> (String, B.ByteString) 93 | getPkg config (arch, release) = (relpath, pack str_data) where 94 | distdir = (configDistDir config) 95 | component = (configComponent config) 96 | relname = (configRelease config) 97 | origin = (configOrigin config) 98 | label = (configLabel config) 99 | path = concat $ intersperse "/" 100 | [distdir, relname, component, 101 | ("binary-" ++ arch), "Packages"] 102 | relpath = concat $ intersperse "/" 103 | [component, ("binary-" ++ arch), "Packages"] 104 | str_data = unroll $ map snd $ M.assocs release 105 | 106 | writePackages :: ApotikiConfig -> (String, B.ByteString) -> IO (String, [String]) 107 | writePackages config (relpath, payload) = do 108 | let path = concat $ intersperse "/" [(configDistDir config), 109 | (configRelease config), 110 | relpath] 111 | B.writeFile path payload 112 | return (relpath, flatinfo $ fileinfo payload) 113 | 114 | writeGzPackages :: ApotikiConfig -> (String, B.ByteString) -> IO (String, [String]) 115 | writeGzPackages config (relpath, payload) = do 116 | let path = concat $ intersperse "/" [(configDistDir config), 117 | (configRelease config), 118 | relpath ++ ".gz"] 119 | let gzpayload = B.concat $ BL.toChunks $ Z.compress $ BL.fromChunks [payload] 120 | B.writeFile path gzpayload 121 | return (relpath ++ ".gz", flatinfo $ fileinfo gzpayload) 122 | 123 | writeArchRelease :: ApotikiConfig -> (String, ArchRelease) -> IO (String, [String]) 124 | writeArchRelease config (arch,release) = do 125 | let distdir = (configDistDir config) 126 | let component = (configComponent config) 127 | let relname = (configRelease config) 128 | let origin = (configOrigin config) 129 | let label = (configLabel config) 130 | let path = concat $ intersperse "/" 131 | [distdir, relname, component, 132 | ("binary-" ++ arch), "Release"] 133 | let relpath = concat $ intersperse "/" 134 | [component, ("binary-" ++ arch), "Release"] 135 | 136 | let payload = pack $ unroll [M.fromList [("Archive", relname), 137 | ("Component", component), 138 | ("Origin", origin), 139 | ("Label", label), 140 | ("Architecture", arch)]] 141 | B.writeFile path payload 142 | return (relpath, flatinfo $ fileinfo payload) 143 | 144 | md5info (path, [size, sum, _, _]) = " " ++ sum ++ " " ++ size ++ " " ++ path 145 | sha1info (path, [size, _, sum, _]) = " " ++ sum ++ " " ++ size ++ " " ++ path 146 | sha256info (path, [size, _, _, sum]) = " " ++ sum ++ " " ++ size ++ " " ++ path 147 | 148 | writeGlobalRelease :: ApotikiConfig -> [(String, [String])] -> IO () 149 | writeGlobalRelease config info = do 150 | let archs = concat $ intersperse " " (configArchs config) 151 | let origin = configOrigin config 152 | let label = configLabel config 153 | let release = configRelease config 154 | let component = configComponent config 155 | let md5s = concat $ intersperse "\n" $ map md5info info 156 | let sha1s = concat $ intersperse "\n" $ map sha1info info 157 | let sha256s = concat $ intersperse "\n" $ map sha256info info 158 | let sums = concat $ intersperse "\n" $ ["MD5Sum:", 159 | md5s, 160 | "SHA1Sum:", 161 | sha1s, 162 | "SHA256Sum:", 163 | sha256s] 164 | let summary = concat $ intersperse "\n" ["Origin: " ++ origin, 165 | "Label: " ++ label, 166 | "Suite: " ++ release, 167 | "Codename: " ++ release, 168 | "Components: " ++ component, 169 | "Architectures: " ++ archs] 170 | let payload = pack $ summary ++ "\n" ++ sums ++ "\n" 171 | let path = concat $ intersperse "/" [(configDistDir config), 172 | (configRelease config), 173 | "Release"] 174 | 175 | (keys, (time, rng)) <- get_key (configKeyPath config) 176 | let pgp = sign_msg keys time rng payload 177 | B.writeFile (path ++ ".gpg") pgp 178 | B.writeFile path payload 179 | 180 | 181 | releaseMkDir distdir release component arch = 182 | createDirectoryIfMissing True $ concat $ intersperse "/" [distdir, 183 | release, 184 | component, 185 | "binary-" ++ arch] 186 | releaseMkDirs ApotikiConfig {repoDir = repodir, 187 | architectures = archs, 188 | release = release, 189 | component = component} = do 190 | mapM_ (releaseMkDir (repodir ++ "/dists") release component) archs 191 | 192 | writeRelease :: LogChan -> ApotikiConfig -> Release -> IO () 193 | writeRelease logger config release = do 194 | releaseMkDirs config 195 | let pkgs = map (getPkg config) (M.assocs release) 196 | release_files <- mapM (writeArchRelease config) (M.assocs release) 197 | log_info logger $ "wrote release files: " ++ (show $ length release_files) 198 | pkg_files <- mapM (writePackages config) pkgs 199 | log_info logger $ "wrote package files: " ++ (show $ length pkg_files) 200 | pkg_gz_files <- mapM (writeGzPackages config) pkgs 201 | log_info logger $ "wrote package compressed files: " ++ (show $ length pkg_gz_files) 202 | writeGlobalRelease config $ concat [release_files, pkg_files, pkg_gz_files] 203 | -------------------------------------------------------------------------------- /System/Apotiki/Templates.hs: -------------------------------------------------------------------------------- 1 | module System.Apotiki.Templates where 2 | import Data.List (unlines) 3 | 4 | -- 5 | -- I am NOT proud of this heredoc implementation. 6 | -- 7 | 8 | detailsHtml = unlines [ "
", 9 | "
", 10 | " Package: {{repo[arch][name]['Package']}}", 11 | "
", 12 | "
", 13 | "
", 14 | "
Package
", 15 | "
{{repo[arch][name]['Package']}}
", 16 | "
", 17 | "
", 18 | "
Version
", 19 | "
{{repo[arch][name]['Version']}}
", 20 | "
", 21 | "
", 22 | "
Architecture
", 23 | "
{{repo[arch][name]['Architecture']}}
", 24 | "
", 25 | "
", 26 | "
Maintainer
", 27 | "
{{repo[arch][name]['Maintainer']}}
", 28 | "
", 29 | "
", 30 | "
License
", 31 | "
{{repo[arch][name]['License']}}
", 32 | "
", 33 | "
", 34 | "
Installed Size
", 35 | "
{{repo[arch][name]['Installed-Size']}}
", 36 | "
", 37 | "
", 38 | "
Priority
", 39 | "
{{repo[arch][name]['Priority']}}
", 40 | "
", 41 | "
", 42 | "
Depends
", 43 | "
{{repo[arch][name]['Depends']}}
", 44 | "
", 45 | "
", 46 | "
Homepage
", 47 | "
{{repo[arch][name]['Homepage']}}
", 48 | "
", 49 | "
", 50 | "
Vendor
", 51 | "
{{repo[arch][name]['Vendor']}}
", 52 | "
", 53 | "
", 54 | "
Section
", 55 | "
{{repo[arch][name]['Section']}}
", 56 | "
", 57 | "
", 58 | "
Description
", 59 | "
", 60 | " 
",
 61 |                         "      
",
 62 |                         "    
",
 63 |                         "  
",
 64 |                         "
" ]
 65 | 
 66 | indexHtml = unlines [ "",
 67 |                       "",
 68 |                       "",
 69 |                       "  ",
 70 |                       "    apotiki debian repository",
 71 |                       "    ",
 72 |                       "    ",
 73 |                       "    ",
 74 |                       "    ",
 75 |                       "    ",
 76 |                       "  ",
 77 |                       "",
 78 |                       "  ",
 79 |                       "    
",
 80 |                       "      
",
 81 |                       "        
",
 82 |                       "          apotiki",
 83 |                       "        
",
 84 |                       "        
",
 85 |                       "          ",
 89 |                       "        
",
 90 |                       "      
",
 91 |                       "    
",
 92 |                       "      ",
 93 |                       "    
",
 94 |                       "      
",
 95 |                       "        
",
 96 |                       "          ",
 97 |                       "        
",
 98 |                       "      
",
 99 |                       "    
",
100 |                       "    ",
101 |                       "  ",
102 |                       "  ",
103 |                       "" ]
104 | 
105 | postHtml = unlines [ "",
106 |                      "",
107 |                      "  ",
108 |                      "    apotiki debian repository",
109 |                      "    ",
110 |                      "    ",
111 |                      "  ",
112 |                      "  ",
113 |                      "    
",
114 |                      "      
",
115 |                      "        
",
116 |                      "          apotiki",
117 |                      "        
",
118 |                      "        
",
119 |                      "          ",
123 |                      "        
",
124 |                      "      
",
125 |                      "    
",
126 |                      "    
",
127 |                      "      
",
128 |                      "        
",
129 |                      "
",
130 |                      "  
",
131 |                      "    
Package
",
132 |                      "  
",
133 |                      "  
",
134 |                      "    
",
135 |                      "      
",
136 |                      "        ",
137 |                      "        ",
138 |                      "        
",
139 |                      "          Package file will overwrite any previous versions.",
140 |                      "        
",
141 |                      "      
",
142 |                      "      ",
143 |                      "    
",
144 |                      "  
",
145 |                      "
",
146 |                      "        
",
147 |                      "      
",
148 |                      "    
",
149 |                      "  ",
150 |                      ""]
151 | 
152 | listingHtml = unlines [ "
",
153 |                         "  ",
154 |                         "  
",
155 |                         "    
",
156 |                         "      
",
157 |                         "        
Package listing
",
158 |                         "      
",
159 |                         "      
",
160 |                         "        
",
161 |                         "          ",
162 |                         "        
",
163 |                         "      
",
164 |                         "    
",
165 |                         "  
",
166 |                         "  ",
167 |                         "  
",
168 |                         "    ",
169 |                         "      ",
170 |                         "        ",
171 |                         "        ",
172 |                         "        ",
173 |                         "      ",
174 |                         "      ",
175 |                         "        ",
176 |                         "          ",
177 |                         "          ",
178 |                         "          ",
179 |                         "        ",
180 |                         "      ",
181 |                         "    
PackageVersionArchitecture
{{pkg['Package']}}{{pkg['Version']}}{{pkg['Architecture']}}
",
182 |                         "  
",
183 |                         "
" ]
184 | 
185 | jsApp = unlines [ "var app = angular.module('repo', ['ngRoute']);",
186 |                   "app.controller('Apotiki', function($scope, $routeParams, $location, $http) {",
187 |                   "$scope.repolist = []; $scope.repo = {};",
188 |                   "$scope.refresh = function(){$http.get('/repo').success(function(data){$scope.repo=data;for(var k in data){for (var subk in data[k]){$scope.repolist.push(data[k][subk]);}}});};",
189 |                   "if ($routeParams.name) { $scope.name = $routeParams.name; }",
190 |                   "if ($routeParams.arch) { $scope.arch = $routeParams.arch; }",
191 |                   "$scope.refresh();});",
192 |                   "app.config(function($routeProvider) {",
193 |                   "    $routeProvider",
194 |                   "        .when('/repo', {templateUrl: 'listing.html', controller: 'Apotiki'})",
195 |                   "        .when('/repo/:arch/:name', {templateUrl: 'details.html', controller: 'Apotiki'})",
196 |                   "        .when('/post', {templateUrl: 'post.html'})",
197 |                   "        .otherwise({redirectTo: '/repo'});});" ]
198 | 


--------------------------------------------------------------------------------