diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright 2014 Pierre-Yves Ritschard + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,102 @@ +apotiki: a faster debian repository +=================================== + +![apotiki](http://i.imgur.com/3Jmupwb.jpg) + +([image source](http://commons.wikimedia.org/wiki/File:A_view_of_the_map_repository_at_The_National_Archives.jpg)) + +apotiki generates debian repositories fast. its goal is +to be a great companion to [fpm](https://github.com/jordansissel/fpm) and +[jenkins](http://jenkins-ci.org). + +apotiki operates with the following features and constraints: + +* Supports a single debian release +* Supports a single debian component +* Supports an arbitrary number of architectures which need to be preprovisionned +* Requires a valid PGP private key for signing + +## The Story + +You operate a production environment and rely on software that is more recent than is +available on a standard Debian or Ubuntu distribution ? Apotiki helps you distribute +software by creating a separate debian repository which you can add to your apt sources. + +Turns out there's already software available for this, such as [freight](https://github.com/rcrowley/freight), +apotiki's angle is to work very fast for the most common use case. + +## Companion software + +[fpm](https://github.com/jordansissel/fpm) is a great tool to build Debian packages with. +It can produce packages from directories, gems, npm or pip libraries. + +[jenkins](http://jenkins-ci.org) or [travis-ci](http://travis-ci.com) can produce artifacts by running +scripts. + +## Using + +apotiki has two modes of operation, try not to mix the two too much: + +* `apotiki insert`: pushes a list of packages, given on the command line to the repo +* `apotiki web`: start up a web service on port 8000 to display the repository and accept new packages + +Running apotiki with no arguments or `help` will tell you a bit about usage. + +If you wish to submit packages to the repository with curl here is the relevant command line +assuming your package file is `package-foo.deb` + +```bash +curl -X POST -F "package=@/path/to/package-foo.deb" http://repo-host:8000/repo +``` + +## Building + +Apotiki is a haskell program and relies on both the ghc compiler and +cabal. They are probably already available in your platform of choice. + +Once cabal is installed, just run: + +```bash +cabal install +``` + +Alternatively, you can build apotiki with docker. Just run: + +``` +sudo docker build . +``` + +The resulting container will have the built cabal executable. + +## Installing + +You can either run `cabal install` locally or distribute the built +executable available in `dist/build/apotiki/apotiki`. + +## Configuring + +For now the configuration is a serialized haskell structure: + +```haskell +ApotikiConfig { + keyPath = "/etc/apotiki.key", -- path to a PGP private key + architectures = ["amd64", "i386"], -- list of supported architectures + component = "main", -- debian release component + release = "precise", -- debian release name + label = "Apotiki", -- release label + origin = "Apotiki", -- release origin + repoDir = "/srv/repo" -- repository location, expose via http +} +``` +The PGP private key you wish to use can be exported with: + +``` +gpg --export-secret-keys repository-key@your.domain > /etc/apotiki.key +``` + +The config file path can be controlled with the `APOTIKI_CONFIG` environment +variable. + +## Caveats + +Error handling is suboptimal to say the least. we'll get there. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Apotiki/Ar.hs b/System/Apotiki/Ar.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Ar.hs @@ -0,0 +1,49 @@ +module System.Apotiki.Ar (arFromData, arFromFile, ArEntry (..)) where +import Data.Attoparsec.Combinator (manyTill) +import Data.ByteString.Char8 (pack, unpack) +import qualified Data.Map as M +import qualified Data.ByteString as B +import qualified Data.Attoparsec.ByteString as P + +armag = "!\n" -- magic header +arfmag = "`\n" -- magic pad + +data ArEntry = ArEntry { -- A file entry in an ar file + entryDate :: Int, + entryGid :: Int, + entryUid :: Int, + entryMode :: Int, + entrySize :: Int, + entryData :: B.ByteString + } deriving Show + +type ArMapEntry = (String, ArEntry) +type ArMap = M.Map String ArEntry + +arEntryParser :: P.Parser ArMapEntry +arEntryParser = do + let not_space = (\c -> (c /= '/') && (c /= ' ')) + name <- (takeWhile not_space . unpack) `fmap` P.take 16 + date <- (read . unpack) `fmap` P.take 12 + gid <- (read . unpack) `fmap` P.take 6 + uid <- (read . unpack) `fmap` P.take 6 + mode <- (read . unpack) `fmap` P.take 8 + size <- (read . unpack) `fmap` P.take 10 + magic <- P.string $ pack arfmag + payload <- P.take size + padding <- if size `mod` 2 == 1 then P.string $ pack "\n" else P.take 0 + return (name, ArEntry date gid uid mode size payload) + +arParser :: P.Parser ArMap +arParser = do + magic <- P.string $ pack armag + entries <- manyTill arEntryParser P.endOfInput + return (M.fromList entries) + +arFromData :: B.ByteString -> Either String ArMap +arFromData input = P.parseOnly arParser input + +arFromFile :: String -> IO (Either String ArMap) +arFromFile path = do + content <- B.readFile path + return (arFromData content) diff --git a/System/Apotiki/Config.hs b/System/Apotiki/Config.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Config.hs @@ -0,0 +1,21 @@ +module System.Apotiki.Config where + +data ApotikiConfig = ApotikiConfig { + keyPath :: String, + architectures :: [String], + component :: String, + release :: String, + label :: String, + origin :: String, + repoDir :: String + } deriving (Show, Read) + +configKeyPath ApotikiConfig { keyPath = x } = x +configArchs ApotikiConfig { architectures = x } = x +configComponent ApotikiConfig { component = x } = x +configRelease ApotikiConfig { release = x } = x +configPoolDir ApotikiConfig { repoDir = x } = x ++ "/pool" +configDistDir ApotikiConfig { repoDir = x } = x ++ "/dists" +configRepoDir ApotikiConfig { repoDir = x } = x +configOrigin ApotikiConfig { origin = x } = x +configLabel ApotikiConfig { label = x } = x diff --git a/System/Apotiki/Debian/Control.hs b/System/Apotiki/Debian/Control.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Debian/Control.hs @@ -0,0 +1,42 @@ +module System.Apotiki.Debian.Control (DebInfo, ctlFromData) where +import System.Apotiki.Utils +import Data.Attoparsec.Combinator (manyTill, many1) +import Data.ByteString.Char8 (pack, unpack) +import Data.List (intersperse) +import qualified Data.Map as M +import qualified Data.ByteString as B +import qualified Data.Attoparsec.ByteString as P + +type DebInfo = M.Map String String + +ctlValParser :: P.Parser String +ctlValParser = do + P.string $ pack " " + val <- unpack `fmap` P.takeWhile (P.notInClass "\n") + P.string $ pack "\n" + return val + +ctlFlatDescParser = (concat . intersperse "\n ") `fmap` many1 ctlValParser + +ctlEntryParser :: P.Parser (String, String) +ctlEntryParser = do + k <- unpack `fmap` P.takeWhile (P.notInClass ":") + P.string $ pack ":" + v <- if (k == "Description") then ctlFlatDescParser else ctlValParser + return (k, strip v) + +ctlParser :: P.Parser DebInfo +ctlParser = M.fromList `fmap` many1 ctlEntryParser + +ctlFromData :: B.ByteString -> Either String DebInfo +ctlFromData input = P.parseOnly ctlParser input + +ctlFromFile :: String -> IO (Either String DebInfo) +ctlFromFile path = do + content <- B.readFile path + return (ctlFromData content) + +test :: IO () +test = do + info <- ctlFromFile "/tmp/control" + putStrLn $ show $ info diff --git a/System/Apotiki/Debian/Package.hs b/System/Apotiki/Debian/Package.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Debian/Package.hs @@ -0,0 +1,39 @@ +module System.Apotiki.Debian.Package where +import System.Apotiki.Ar +import System.Apotiki.Tar +import System.Apotiki.FileInfo +import System.Apotiki.Utils +import System.Apotiki.Config +import System.Apotiki.Debian.Control +import Data.List +import System.Directory +import Data.ByteString.Char8 (pack, unpack) +import qualified Data.ByteString as B +import qualified Data.Map as M + +writeToPool :: String -> (DebInfo, B.ByteString) -> IO () +writeToPool repodir (info, payload) = do + let path = info M.! "Filename" + let dir_path = reverse $ snd $ break (== '/') $ reverse path + putStrLn $ "found filename: " ++ path + createDirectoryIfMissing True (repodir ++ "/" ++ dir_path) + B.writeFile (repodir ++ "/" ++ path) payload + B.writeFile (repodir ++ "/" ++ dir_path ++ "control") $ pack (show info) + +toDebInfo :: String -> DebInfo +toDebInfo input = output where Right output = ctlFromData $ pack $ input + +debInfo :: ApotikiConfig -> B.ByteString -> DebInfo +debInfo config payload = + M.union (fileinfo payload) (M.insert "Filename" path debinfo) where + Right archive = (arFromData payload) + ArEntry {entryData = entry} = archive M.! "control.tar.gz" + debinfo = toDebInfo $ getStrictControl entry + arch = case M.lookup "Architecture" debinfo of + Nothing -> "NOARCH" + Just x -> x + pkg = case M.lookup "Package" debinfo of + Nothing -> "NOPKG" + Just x -> x + pooldir = configPoolDir config + path = "pool/" ++ arch ++ "/" ++ pkg ++ "/" ++ pkg ++ ".deb" diff --git a/System/Apotiki/Debian/Release.hs b/System/Apotiki/Debian/Release.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Debian/Release.hs @@ -0,0 +1,201 @@ +module System.Apotiki.Debian.Release where +import System.Apotiki.Debian.Package +import System.Apotiki.Debian.Control +import System.Apotiki.FileInfo +import System.Apotiki.Config +import System.Apotiki.Signature +import System.Directory +import System.IO +import Data.List +import Data.Function +import Data.ByteString.Char8 (pack,unpack) +import Data.Aeson +import qualified System.IO.Strict as SIO +import qualified Codec.Compression.GZip as Z +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map as M + +type ArchRelease = M.Map String DebInfo +type Release = M.Map String ArchRelease + +flatinfo fileinfo = [fileinfo M.! "Size", fileinfo M.! "MD5sum", + fileinfo M.! "SHA1", fileinfo M.! "SHA256"] + +unrollEntry (k,v) = k ++ ": " ++ v +unrollMap input = concat $ intersperse "\n" $ map unrollEntry $ M.assocs input + +unroll :: [DebInfo] -> String +unroll input = (concat $ intersperse "\n\n" $ map unrollMap input) ++ "\n" + +pkgControl pooldir arch pkg = do + let path = pooldir ++ "/" ++ arch ++ "/" ++ pkg ++ "/control" + fd <- openFile path ReadMode + control_data <- SIO.hGetContents fd + let output = (read control_data :: DebInfo) + hClose fd + return output + +archRelease pooldir arch = do + let path = pooldir ++ "/" ++ arch + entries <- getDirectoryContents path + let pkgs = filter ((/= '.') . head) entries + controls <- mapM (pkgControl pooldir arch) pkgs + return (M.fromList $ zip pkgs controls) + +loadRelease :: String -> IO (Release) +loadRelease pooldir = do + entries <- getDirectoryContents pooldir + let archs = filter ((/= '.') . head) entries + arch_releases <- mapM (archRelease pooldir) archs + return (M.fromList $ zip archs arch_releases) + +releaseJSON pooldir = do + release <- loadRelease pooldir + let encoded = release + return encoded + +same_arch x y = (fst x) == (fst y) + +releaseByArch archs debinfo = + if arch == "all" then + zip archs (repeat debinfo) + else + [(arch, debinfo)] + where arch = debinfo M.! "Architecture" + +releaseDescr (_,deb) = (package, deb) where + package = deb M.! "Package" + +releaseMap debs = (fst $ head $ debs, + M.fromList $ map releaseDescr debs) + +releaseFrom archs debs = M.fromList release_map where + all_debs = concatMap (releaseByArch archs) debs + sorted = sortBy (compare `on` fst) all_debs + by_arch = groupBy same_arch sorted + release_map = map releaseMap by_arch + +mergeRelease new old arch = + M.union new_arch old_arch where + new_arch = case (M.lookup arch new) of + Nothing -> M.fromList [] + Just x -> x + old_arch = case (M.lookup arch old) of + Nothing -> M.fromList [] + Just x -> x + +updateRelease archs old new = M.fromList (zip archs updated) where + updated = map (mergeRelease new old) archs + +getPkg :: ApotikiConfig -> (String, ArchRelease) -> (String, B.ByteString) +getPkg config (arch, release) = (relpath, pack str_data) where + distdir = (configDistDir config) + component = (configComponent config) + relname = (configRelease config) + origin = (configOrigin config) + label = (configLabel config) + path = concat $ intersperse "/" + [distdir, relname, component, + ("binary-" ++ arch), "Packages"] + relpath = concat $ intersperse "/" + [component, ("binary-" ++ arch), "Packages"] + str_data = unroll $ map snd $ M.assocs release + +writePackages :: ApotikiConfig -> (String, B.ByteString) -> IO (String, [String]) +writePackages config (relpath, payload) = do + let path = concat $ intersperse "/" [(configDistDir config), + (configRelease config), + relpath] + B.writeFile path payload + return (relpath, flatinfo $ fileinfo payload) + +writeGzPackages :: ApotikiConfig -> (String, B.ByteString) -> IO (String, [String]) +writeGzPackages config (relpath, payload) = do + let path = concat $ intersperse "/" [(configDistDir config), + (configRelease config), + relpath ++ ".gz"] + let gzpayload = B.concat $ BL.toChunks $ Z.compress $ BL.fromChunks [payload] + B.writeFile path gzpayload + return (relpath ++ ".gz", flatinfo $ fileinfo gzpayload) + +writeArchRelease :: ApotikiConfig -> (String, ArchRelease) -> IO (String, [String]) +writeArchRelease config (arch,release) = do + let distdir = (configDistDir config) + let component = (configComponent config) + let relname = (configRelease config) + let origin = (configOrigin config) + let label = (configLabel config) + let path = concat $ intersperse "/" + [distdir, relname, component, + ("binary-" ++ arch), "Release"] + let relpath = concat $ intersperse "/" + [component, ("binary-" ++ arch), "Release"] + + let payload = pack $ unroll [M.fromList [("Archive", relname), + ("Component", component), + ("Origin", origin), + ("Label", label), + ("Architecture", arch)]] + B.writeFile path payload + return (relpath, flatinfo $ fileinfo payload) + +md5info (path, [size, sum, _, _]) = " " ++ sum ++ " " ++ size ++ " " ++ path +sha1info (path, [size, _, sum, _]) = " " ++ sum ++ " " ++ size ++ " " ++ path +sha256info (path, [size, _, _, sum]) = " " ++ sum ++ " " ++ size ++ " " ++ path + +writeGlobalRelease :: ApotikiConfig -> [(String, [String])] -> IO () +writeGlobalRelease config info = do + let archs = concat $ intersperse " " (configArchs config) + let origin = configOrigin config + let label = configLabel config + let release = configRelease config + let component = configComponent config + let md5s = concat $ intersperse "\n" $ map md5info info + let sha1s = concat $ intersperse "\n" $ map sha1info info + let sha256s = concat $ intersperse "\n" $ map sha256info info + let sums = concat $ intersperse "\n" $ ["MD5Sum:", + md5s, + "SHA1Sum:", + sha1s, + "SHA256Sum:", + sha256s] + let summary = concat $ intersperse "\n" ["Origin: " ++ origin, + "Label: " ++ label, + "Suite: " ++ release, + "Codename: " ++ release, + "Components: " ++ component, + "Architectures: " ++ archs] + let payload = pack $ summary ++ "\n" ++ sums ++ "\n" + let path = concat $ intersperse "/" [(configDistDir config), + (configRelease config), + "Release"] + + (keys, (time, rng)) <- get_key (configKeyPath config) + let pgp = sign_msg keys time rng payload + B.writeFile (path ++ ".gpg") pgp + B.writeFile path payload + + +releaseMkDir distdir release component arch = + createDirectoryIfMissing True $ concat $ intersperse "/" [distdir, + release, + component, + "binary-" ++ arch] +releaseMkDirs ApotikiConfig {repoDir = repodir, + architectures = archs, + release = release, + component = component} = do + mapM_ (releaseMkDir (repodir ++ "/dists") release component) archs + +writeRelease :: ApotikiConfig -> Release -> IO () +writeRelease config release = do + releaseMkDirs config + let pkgs = map (getPkg config) (M.assocs release) + release_files <- mapM (writeArchRelease config) (M.assocs release) + putStrLn $ "wrote release files: " ++ (show $ length release_files) + pkg_files <- mapM (writePackages config) pkgs + putStrLn $ "wrote package files: " ++ (show $ length pkg_files) + pkg_gz_files <- mapM (writeGzPackages config) pkgs + putStrLn $ "wrote package compressed files: " ++ (show $ length pkg_gz_files) + writeGlobalRelease config $ concat [release_files, pkg_files, pkg_gz_files] diff --git a/System/Apotiki/FileInfo.hs b/System/Apotiki/FileInfo.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/FileInfo.hs @@ -0,0 +1,16 @@ +module System.Apotiki.FileInfo (sha256sum, sha1sum, md5sum, fileinfo) where +import qualified Data.ByteString as B +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.MD5 as MD5 +import qualified Text.Printf as P +import qualified Data.Map as M + +gensum input hashfn = B.unpack (hashfn input) >>= P.printf "%02x" +sha256sum input = gensum input SHA256.hash +sha1sum input = gensum input SHA1.hash +md5sum input = gensum input MD5.hash +fileinfo input = M.fromList [("Size", show $ B.length input), + ("MD5sum", md5sum input), + ("SHA1", sha1sum input), + ("SHA256", sha256sum input)] diff --git a/System/Apotiki/Signature.hs b/System/Apotiki/Signature.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Signature.hs @@ -0,0 +1,29 @@ +module System.Apotiki.Signature (sign_msg, get_key) where +import System.Time (getClockTime, ClockTime(..)) +import Crypto.Random +import Data.OpenPGP +import qualified Data.Binary as Binary +import qualified Data.OpenPGP.CryptoAPI as PGP +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString as BS +import Codec.Encryption.OpenPGP.ASCIIArmor as Armor +import Codec.Encryption.OpenPGP.ASCIIArmor.Types as Armor + +get_key keypath = do + keys <- Binary.decodeFile keypath + TOD tod _ <- getClockTime + rng <- newGenIO :: IO SystemRandom + let time = (fromIntegral tod :: Integer) + return (keys, (time, rng)) + +sign_msg :: (CryptoRandomGen g) => Message -> Integer -> g -> BS.ByteString -> BS.ByteString +sign_msg keys time rng payload = + Armor.encode [armor] where + wtime = (fromIntegral time :: Binary.Word32) + lazy_payload = B.fromChunks [payload] + pgp_payload = LiteralDataPacket 'b' "" wtime lazy_payload + input = (DataSignature pgp_payload []) + (DataSignature _ [sig], _) = PGP.sign keys input SHA256 [] time rng + options = [("Version", "OpenPrivacy 0.99"), ("Hash", "SHA256")] + encoded_sig = Binary.encode sig + armor = Armor.Armor Armor.ArmorSignature options encoded_sig diff --git a/System/Apotiki/Tar.hs b/System/Apotiki/Tar.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Tar.hs @@ -0,0 +1,31 @@ +module System.Apotiki.Tar (getControl, getStrictControl) where +import Data.List +import qualified Data.Map as M +import qualified Codec.Archive.Tar as Tar +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.Char8 as BC +import qualified Codec.Compression.GZip as Z + +tarEntryList :: Tar.Entries Tar.FormatError -> [Tar.Entry] -> [Tar.Entry] +tarEntryList entries outlist = + case entries of + Tar.Next entry (more) -> (tarEntryList more (entry:outlist)) + Tar.Done -> outlist + Tar.Fail e -> error (show e) + +tarEntryPayload :: Tar.EntryContent -> String +tarEntryPayload (Tar.NormalFile payload size) = BC.unpack payload + +getStrictControl :: BS.ByteString -> String +getStrictControl content = + getControl $ B.fromChunks [content] + +getControl :: B.ByteString -> String +getControl content = + tarEntryPayload $ Tar.entryContent entry + where unzipped = Z.decompress content + entries = tarEntryList (Tar.read unzipped) [] + entry = case find ((== "./control") . Tar.entryPath) entries of + Just entry -> entry + Nothing -> error (show $ map Tar.entryPath entries) diff --git a/System/Apotiki/Utils.hs b/System/Apotiki/Utils.hs new file mode 100644 --- /dev/null +++ b/System/Apotiki/Utils.hs @@ -0,0 +1,19 @@ +module System.Apotiki.Utils (strip) where +import Data.List + +-- inspired by MissingH + +wschars :: String +wschars = " \t\r\n" + +is_white :: Char -> Bool +is_white c = isInfixOf [c] wschars + +lstrip :: String -> String +lstrip s = dropWhile is_white s + +rstrip :: String -> String +rstrip = reverse . lstrip . reverse + +strip :: String -> String +strip = lstrip . rstrip diff --git a/apotiki.cabal b/apotiki.cabal new file mode 100644 --- /dev/null +++ b/apotiki.cabal @@ -0,0 +1,72 @@ +-- Initial apotiki.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: apotiki +version: 0.5.1 +synopsis: a faster debian repository +description: + apotiki generates debian repositories fast. its goal is + to be a great companion to fpm and jenkins. + . + apotiki operates with the following features and constraints: + . + - Supports a single debian release + . + - Supports a single debian component + . + - Supports an arbitrary number of architectures which need to be preprovisionned + . + - Requires a valid PGP private key for signing + +-- description: +homepage: https://github.com/pyr/apotiki +license: MIT +license-file: LICENSE +author: Pierre-Yves Ritschard +maintainer: pyr@spootnik.org +-- copyright: +category: System +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 +extra-source-files: README.md + System/Apotiki/Debian/*.hs + System/Apotiki/*.hs + static/*.js static/*.html + +library + exposed-modules: System.Apotiki.Ar + System.Apotiki.Debian.Package + System.Apotiki.Debian.Release + build-depends: base >=4.6 && <4.7, bytestring >= 0.10.0.2, + containers >= 0.5.0.0, cryptohash >= 0.9.1, + zlib >= 0.5.4.1, tar >= 0.4.0.1, aeson >= 0.6.2.1, + attoparsec >= 0.10.4.0, directory >= 1.2.0.1, + openpgp-asciiarmor >= 0.1, openpgp-crypto-api >= 0.6.3, + binary >= 0.7.1.0, openpgp >= 0.6.1, strict >= 0.3.2, + crypto-api == 0.12.2.2, old-time >= 1.1.0.1, + scotty >= 0.6.2, wai-extra >= 2.0.3.1, text >= 1.0.0.1, + http-types >= 0.8.3, transformers >= 0.3.0.0, + transformers >= 0.3.0.0, wai-middleware-static >= 0.4.0.2 + default-language: Haskell2010 + -- other-modules: + -- other-extensions: + +executable apotiki + main-is: apotiki.hs + ghc-options: -threaded + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7, bytestring >= 0.10.0.2, + containers >= 0.5.0.0, cryptohash >= 0.9.1, + zlib >= 0.5.4.1, tar >= 0.4.0.1, aeson >= 0.6.2.1, + attoparsec >= 0.10.4.0, directory >= 1.2.0.1, + openpgp-asciiarmor >= 0.1, openpgp-crypto-api >= 0.6.3, + binary >= 0.7.1.0, openpgp >= 0.6.1, strict >= 0.3.2, + crypto-api == 0.12.2.2, old-time >= 1.1.0.1, + scotty >= 0.6.2, wai-extra >= 2.0.3.1, text >= 1.0.0.1, + http-types >= 0.8.3, transformers >= 0.3.0.0, + transformers >= 0.3.0.0, wai-middleware-static >= 0.4.0.2 + + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/apotiki.hs b/apotiki.hs new file mode 100644 --- /dev/null +++ b/apotiki.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where +import System.Apotiki.Debian.Package +import System.Apotiki.Debian.Release +import System.Apotiki.Config +import Data.Map (keys) +import System.Environment +import System.Directory +import Control.Exception + +import Network.HTTP.Types.Status +import Web.Scotty +import Data.Text (pack) +import Data.Text.Lazy (unpack) +import Data.ByteString.Lazy (toChunks) +import Network.Wai.Middleware.RequestLogger +import Network.Wai.Parse + +import Data.Aeson (object, (.=)) +import Control.Monad (guard) +import System.IO.Error (isDoesNotExistError) +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString as B + +import Network.Wai.Middleware.Static + +setupRepo config = do + createDirectoryIfMissing True (configDistDir config) + createDirectoryIfMissing True (configPoolDir config) + +main :: IO () +main = do + -- first fetch our config + result <- tryJust (guard . isDoesNotExistError) $ getEnv "APOTIKI_CONFIG" + let confpath = case result of + Left e -> "/etc/apotiki.conf" + Right val -> val + confdata <- readFile confpath + let config = read confdata :: ApotikiConfig + args <- getArgs + runCommand config args + +runCommand config [] = runCommand config ["help"] + +runCommand config ("help":debfiles) = do + putStrLn "usage: apotiki {web, insert} [packages]" + +runCommand config ("web":_) = do + setupRepo config + scotty 8000 $ do + middleware $ staticPolicy (noDots >-> addBase "static") + get "/" $ do + redirect "/index.html" + get "/repo" $ do + repo <- liftIO (releaseJSON $ configPoolDir config) + json repo + post "/repo" $ do + indata <- files + let debfiles = [B.concat $ toChunks $ fileContent fi | (_,fi) <- indata] + liftIO $ insertPackages config debfiles + redirect "/index.html" + +runCommand config ("insert":filenames) = do + setupRepo config + debfiles <- mapM B.readFile filenames + insertPackages config debfiles + +insertPackages config debfiles = do + -- now load our view of the world + old_release <- loadRelease $ configPoolDir config + putStrLn $ "got previous release: " ++ (show $ length $ keys old_release) + + let debinfo = map (debInfo config) debfiles + let archs = configArchs config + let pending_release = releaseFrom archs debinfo + + putStrLn $ "got pending release: " ++ (show $ length $ keys pending_release) + + -- merge old and new release + let release = updateRelease archs old_release pending_release + + writeRelease config release + + -- write package to their destination + mapM_ (writeToPool $ configRepoDir config) $ zip debinfo debfiles + + putStrLn "done updating repository" diff --git a/static/apotiki.js b/static/apotiki.js new file mode 100644 --- /dev/null +++ b/static/apotiki.js @@ -0,0 +1,31 @@ +var app = angular.module('repo', ['ngRoute']); + +app.controller('Apotiki', function($scope, $routeParams, $location, $http) { + + $scope.repolist = []; + $scope.repo = {}; + + $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]); + } + } + }); + }; + + if ($routeParams.name) { $scope.name = $routeParams.name; } + if ($routeParams.arch) { $scope.arch = $routeParams.arch; } + + $scope.refresh(); +}); + +app.config(function($routeProvider) { + $routeProvider + .when('/repo', {templateUrl: 'listing.html', controller: 'Apotiki'}) + .when('/repo/:arch/:name', {templateUrl: 'details.html', controller: 'Apotiki'}) + .when('/post', {templateUrl: 'post.html'}) + .otherwise({redirectTo: '/repo'}); +}); diff --git a/static/details.html b/static/details.html new file mode 100644 --- /dev/null +++ b/static/details.html @@ -0,0 +1,60 @@ +
+ +
+ Package: {{repo[arch][name]['Package']}} +
+ +
+
+
Package
+
{{repo[arch][name]['Package']}}
+
+
+
Version
+
{{repo[arch][name]['Version']}}
+
+
+
Architecture
+
{{repo[arch][name]['Architecture']}}
+
+
+
Maintainer
+
{{repo[arch][name]['Maintainer']}}
+
+
+
License
+
{{repo[arch][name]['License']}}
+
+
+
Installed Size
+
{{repo[arch][name]['Installed-Size']}}
+
+
+
Priority
+
{{repo[arch][name]['Priority']}}
+
+
+
Depends
+
{{repo[arch][name]['Depends']}}
+
+
+
Homepage
+
{{repo[arch][name]['Homepage']}}
+
+
+
Vendor
+
{{repo[arch][name]['Vendor']}}
+
+
+
Section
+
{{repo[arch][name]['Section']}}
+
+
+
Description
+
+ 

+      

+    

+  

+  
+

diff --git a/static/index.html b/static/index.html
new file mode 100644
--- /dev/null
+++ b/static/index.html
@@ -0,0 +1,38 @@
+
+
+
+  
+    apotiki debian repository
+    
+    
+    
+    
+    
+  
+
+  
+    
+      
+    

+      

+        

+          
+        

+      

+    

+    
+  
+  
+
diff --git a/static/listing.html b/static/listing.html
new file mode 100644
--- /dev/null
+++ b/static/listing.html
@@ -0,0 +1,32 @@
+

+  
+  

+    

+      

+        
Package listing

+      

+      

+        

+          
+        

+      

+    

+  

+  
+  

+    
+      
+        
+        
+        
+      
+      
+        
+          
+          
+          
+        
+      
+    
PackageVersionArchitecture
{{pkg['Package']}}{{pkg['Version']}}{{pkg['Architecture']}}

+  

+

diff --git a/static/post.html b/static/post.html
new file mode 100644
--- /dev/null
+++ b/static/post.html
@@ -0,0 +1,58 @@
+
+
+
+  
+    apotiki debian repository
+    
+    
+  
+
+  
+    
+      
+    

+      

+        

+
+

+  
+  

+    
Package

+  

+  
+  

+    

+      

+        
+        
+        

+          Package file will overwrite any previous versions.
+        

+      

+      
+    

+  

+

+
+
+        

+      

+    

+    
+  
+  
+
+
+