[Lsb-messages] /var/www/bzr/lsb/devel/repogen r195: Add the files from the "debianize" experimental project.

Jeff Licquia licquia at linuxfoundation.org
Thu Jun 13 02:35:11 UTC 2013


------------------------------------------------------------
revno: 195
committer: Jeff Licquia <licquia at linuxfoundation.org>
branch nick: repogen
timestamp: Wed 2013-06-12 19:35:11 -0700
message:
  Add the files from the "debianize" experimental project.
  
  I started an experiment to create a new way of doing Debian packages.
  The experiment worked out so well, it's time to make it the mainstream
  way of doing Debian packages for the LSB.  So, let's pull it into the
  main repogen repository.
  
  For now, the Makefile for the new way is separate.  We will need to
  merge the old and new Makefiles so the new process fits with the old.
added:
  Package.hs
  deb/Makefile-haskell
  deb/missingdebs.hs
  deb/override-from-deb.hs
-------------- next part --------------
=== added file 'Package.hs'
--- a/Package.hs	1970-01-01 00:00:00 +0000
+++ b/Package.hs	2013-06-13 02:35:11 +0000
@@ -0,0 +1,217 @@
+-- Package.hs - simple package manipulation
+-- Copyright 2013 Linux Foundation.
+
+-- This module generates package metadata given the path to the package
+-- in question.  Right now, we parse the package filename for the metadata,
+-- though in the future we could actually read it from the package file.
+-- Parsing the filename has the advantage of being simpler, although some
+-- information is likely to be incorrect.
+-- XXX: We currently don't parse epochs.  This is sufficient for our
+--      purposes here, but could be a problem in other cases.
+
+module Package where
+
+import Data.Maybe
+import Data.List
+import Data.List.Split
+import System.FilePath
+
+-- Type definitions
+
+data PackageType = Rpm | Deb deriving (Eq, Show)
+
+data Package = Package { path :: FilePath,
+                         pkgtype :: PackageType,
+                         name :: String,
+                         epoch :: String,
+                         version :: String,
+                         release :: String,
+                         arch :: String } deriving (Show)
+
+instance Eq Package where
+    x == y = (pkgtype x == pkgtype y) &&
+             (comparePkgName (name x) (name y)) &&
+             (epoch x == epoch y) &&
+             (version x == version y) &&
+             (release x == release y) &&
+             (arch x == arch y)
+
+-- Helper functions for constructing Packages.
+
+hasUnderscore :: String -> Bool
+hasUnderscore = ('_' `elem`)
+
+underscoreToEnd :: String -> String
+underscoreToEnd s = last $ splitOn "_" s
+
+packageTypeFromPath :: FilePath -> Maybe PackageType
+packageTypeFromPath path
+    | ext == ".deb" = Just Deb
+    | ext == ".rpm" = Just Rpm
+    | otherwise     = Nothing
+    where ext = takeExtension path
+
+packageArchFromPath :: FilePath -> Maybe String
+packageArchFromPath path
+    | packageTypeFromPath path == Just Deb && hasUnderscore noExtension
+      = Just (underscoreToEnd noExtension)
+    | packageTypeFromPath path == Just Rpm && hasExtension noExtension 
+      = Just (tail $ takeExtension noExtension)
+    | otherwise
+      = Nothing
+    where noExtension = dropExtension path
+
+packageNEVRAFromPath :: FilePath -> Maybe [String]
+packageNEVRAFromPath path
+    | pkgtype == Just Deb && '_' `elem` path && isJust arch
+      = let deb_elements = splitOn "_" $ takeFileName path
+        in Just [head $ deb_elements,
+              "0",
+              head $ splitOn "-" $ deb_elements !! 1,
+              last $ splitOn "-" $ deb_elements !! 1,
+              fromJust arch]
+    | pkgtype == Just Rpm && '-' `elem` path && isJust arch
+      = let shortFileName = (iterate dropExtension $ takeFileName path) !! 2
+            rpm_elements = splitOn "-" shortFileName
+        in Just [intercalate "-" $ init $ init $ rpm_elements,
+              "0",
+              last $ init $ rpm_elements,
+              last $ rpm_elements,
+              fromJust arch]
+    | otherwise
+      = Nothing
+    where pkgtype = packageTypeFromPath path
+          arch = packageArchFromPath path
+
+-- It turns out that names can be tricky.  Debian packages have more
+-- strict naming requirements than RPMs, so certain names have to be
+-- changed.  This also means that we have to allow the converted
+-- characters to be equivalent when, say, comparing a package
+-- constructed from a path to a derived package.  So, these functions
+-- make all these little things possible.
+
+convertRpmName :: String -> String
+convertRpmName "" = ""
+convertRpmName (x:xs)
+    | x == '_'
+      = '-':convertRpmName xs
+    | otherwise
+      = x:convertRpmName xs
+
+comparePkgName :: String -> String -> Bool
+comparePkgName "" "" = True
+comparePkgName "" _ = False
+comparePkgName _ "" = False
+comparePkgName (x:xs) (y:ys)
+    | (x `elem` uChars && y `elem` uChars) || (x == y)
+      = True && comparePkgName xs ys
+    | otherwise
+      = False
+    where uChars = "-_"
+
+-- Given a FilePath, construct a Package.
+
+packageFromPath :: FilePath -> Maybe Package
+packageFromPath path 
+    | isJust maybeNEVRA && isJust maybePkgType
+      = Just Package {
+          path=path,
+          pkgtype=fromJust maybePkgType,
+          name=(fromJust maybeNEVRA) !! 0,
+          epoch=(fromJust maybeNEVRA) !! 1,
+          version=(fromJust maybeNEVRA) !! 2,
+          release=(fromJust maybeNEVRA) !! 3,
+          arch=(fromJust maybeNEVRA) !! 4 }
+    | otherwise
+      = Nothing
+    where maybeNEVRA = packageNEVRAFromPath path
+          maybePkgType = packageTypeFromPath path
+
+-- Debian does not support some of the architectures RPM does.
+-- These functions report on architecture support.
+
+rpmArchNames = ["i486", "ia64", "ppc", "s390", "x86_64", "noarch"]
+debArchNames = ["i386", "ia64", "powerpc", "s390", "amd64", "all"]
+
+archRpmToDeb :: String -> Maybe String
+archRpmToDeb s = lookup s $ zip rpmArchNames debArchNames
+
+archDebToRpm :: String -> Maybe String
+archDebToRpm s = lookup s $ zip debArchNames rpmArchNames
+
+-- We generate Debian packages from RPMs.  This function generates
+-- information about what a generated Debian package should look like.
+
+derivedDeb :: Package -> Maybe Package
+derivedDeb p
+    | pkgtype p == Deb = Just p
+    | isJust cvtArch = Just Package {
+        path="",
+        pkgtype=Deb,
+        name=convertRpmName $ name p,
+        epoch=epoch p,
+        version=version p,
+        release=release p,
+        arch=fromJust cvtArch }
+    | otherwise = Nothing
+    where cvtArch = archRpmToDeb $ arch p
+
+-- Given a Debian package, do the reverse of derivedDeb: figure out
+-- which RPM it came from.
+
+derivedRpm :: Package -> Package
+derivedRpm p
+    | pkgtype p == Rpm = p
+    | otherwise = Package {
+        path="",
+        pkgtype=Rpm,
+        name=name p,
+        epoch=epoch p,
+        version=version p,
+        release=release p,
+        arch=maybe debArch id $ archDebToRpm debArch }
+    where debArch = arch p
+
+-- Convert a generic Package to its other type.
+
+convertPkg :: Package -> Maybe Package
+convertPkg p
+    | pkgtype p == Deb
+      = Just $ derivedRpm p
+    | pkgtype p == Rpm
+      = derivedDeb p
+
+-- For a Package not created via a FilePath (for example, a derived Package
+-- created by convertPkg), the path is likely blank.  Allow for
+-- "un-blanking" the path by deriving a file name from the metadata.
+
+fileNameFromPackage :: Package -> FilePath
+fileNameFromPackage p
+    | pkgtype p == Deb
+      = name p ++ "_" ++ version p ++ "-" ++ release p ++ "_" ++ arch p ++ ".deb"
+    | otherwise
+      = name p ++ "-" ++ version p ++ "-" ++ release p ++ "." ++ arch p ++ ".rpm"
+
+packageRecalcPath :: Package -> Package
+packageRecalcPath p = Package {
+    path=fileNameFromPackage p,
+    name=name p,
+    epoch=epoch p,
+    version=version p,
+    release=release p,
+    arch=arch p,
+    pkgtype=pkgtype p }
+
+-- "Rehome" a package; change its path to point to a different directory.
+-- This can be used as the basis for copying, or to direct conversion of
+-- a derivedDeb Package.
+
+packageRehome :: Package -> FilePath -> Package
+packageRehome p newpath = Package {
+    path=replaceDirectory (path p) newpath,
+    name=name p,
+    epoch=epoch p,
+    version=version p,
+    release=release p,
+    arch=arch p,
+    pkgtype=pkgtype p }

=== added file 'deb/Makefile-haskell'
--- a/deb/Makefile-haskell	1970-01-01 00:00:00 +0000
+++ b/deb/Makefile-haskell	2013-06-13 02:35:11 +0000
@@ -0,0 +1,114 @@
+DEB_ARCHS=i386 ia64 amd64 s390 powerpc
+REPO_TOP = /srv/ftp/pub/lsb/repositories/debian
+GPG_ID = AACCA736
+GPG_HOMEDIR = /opt/buildbot/reposig
+
+default: dists/lsb-3.0/Release dists/lsb-3.1/Release dists/lsb-3.2/Release \
+    dists/lsb-4.0/Release dists/lsb-4.1/Release
+
+missingdebs: ../Package.hs missingdebs.hs
+	ghc -v0 -i.. --make $@
+
+override-from-deb: ../Package.hs override-from-deb.hs
+	ghc -v0 -i.. --make $@
+
+rpmlist-snapshot:
+	find /srv/ftp/pub/lsb/snapshots -name \*rpm -print | fgrep -v src.rpm | fgrep -v appbat > $@
+
+rpmlist-common:
+	find /srv/ftp/pub/lsb/lsbdev/released-all -name \*rpm -print | fgrep -v src.rpm > $@
+	find /srv/ftp/pub/lsb/test_suites/released-all -name \*rpm -print | fgrep -v src.rpm >> $@
+	find /srv/ftp/pub/lsb/base/released-all -name \*rpm -print | fgrep -v src.rpm >> $@
+
+rpmlist-%:
+	find -L /srv/ftp/pub/lsb/app-battery/released-$* -name lsb-python\* -print > $@
+	find -L /srv/ftp/pub/lsb/test_suites/released-$*/binary/runtime -name \*rpm -print >> $@
+
+pool/pkgs-%-old:
+	mkdir -p $@
+	cp -a $(REPO_TOP)/pkgs-$*/* $@
+
+missing-%: rpmlist-% missingdebs pool/pkgs-%-old
+	(cat rpmlist-$*; ls pool/pkgs-$*-old/*) | ./missingdebs > $@
+
+pool/pkgs-%: pool/pkgs-%-old missing-%
+	rm -rf $@
+	cp -a pool/pkgs-$*-old $@
+	grep ^+ missing-$* | cut -f2 -d' ' | \
+	    (while read f; do echo "$*: $$(basename $$f)"; ./makedeb -o $@ $$f; done)
+	grep ^- missing-$* | cut -f2 -d' ' | sed 's/$*-old/$*/' |\
+	    (while read f; do echo "rm: $$(basename $$f)"; rm $$f; done)
+
+apt-overrides-snapshot: pool/pkgs-snapshot override-from-deb
+	ls pool/pkgs-snapshot/* | (while read f; do ./override-from-deb $$f; done) | sort | uniq > $@
+
+apt-overrides-%: pool/pkgs-% pool/pkgs-common override-from-deb
+	ls pool/pkgs-$*/* pool/pkgs-common/* | (while read f; do ./override-from-deb $$f; done) | sort | uniq > $@
+
+fakepool-%: pool/pkgs-% pool/pkgs-common
+	mkdir -p fakepool-$*
+	[ -L fakepool-$*/pkgs-common ] \
+	  || ln -s ../pool/pkgs-common fakepool-$*/pkgs-common
+	ln -s ../pool/pkgs-$* fakepool-$*/pkgs-$*
+
+dists/lsb-snapshot/main: apt-overrides-snapshot pool/pkgs-snapshot
+	for arch in $(DEB_ARCHS); do \
+	  mkdir -p dists/lsb-snapshot/main/binary-$$arch; \
+	  (cd pool && dpkg-scanpackages -a$$arch pkgs-snapshot ../apt-overrides-snapshot) \
+	    > dists/lsb-snapshot/main/binary-$$arch/Packages \
+	    2>/dev/null; \
+	  gzip < dists/lsb-snapshot/main/binary-$$arch/Packages \
+	    > dists/lsb-snapshot/main/binary-$$arch/Packages.gz; \
+	  sed s/@LSB_VERSION@/snapshot/ < Release.arch.in \
+	    | sed s/@CURRENT_DEB_ARCH@/$$arch/ \
+	    > dists/lsb-snapshot/main/binary-$$arch/Release; \
+	done
+
+dists/lsb-%/main: apt-overrides-% fakepool-% Release.arch.in
+	for arch in $(DEB_ARCHS); do \
+	  mkdir -p dists/lsb-$*/main/binary-$$arch; \
+	  (cd fakepool-$* && dpkg-scanpackages -a$$arch . ../apt-overrides-$*) \
+	    > dists/lsb-$*/main/binary-$$arch/Packages \
+	    2>/dev/null; \
+	  gzip < dists/lsb-$*/main/binary-$$arch/Packages \
+	    > dists/lsb-$*/main/binary-$$arch/Packages.gz; \
+	  sed s/@LSB_VERSION@/$*/ < Release.arch.in \
+	    | sed s/@CURRENT_DEB_ARCH@/$$arch/ \
+	    > dists/lsb-$*/main/binary-$$arch/Release; \
+	done
+
+dists/lsb-%/Release: dists/lsb-%/main Release.top.in gen_hashes
+	sed s/@LSB_VERSION@/$*/ < Release.top.in | \
+	  sed "s/@DEB_ARCHS@/$(DEB_ARCHS)/" | \
+	  sed "s/@BUILD_DATE@/$(shell date -Ru)/" > $@
+	./gen_hashes dists/lsb-$* >> $@
+
+dists/lsb-%/Release.gpg: dists/lsb-%/Release
+	gpg -sab -u $(GPG_ID) --homedir $(GPG_HOMEDIR) -o $@ $<
+
+install: install-3.0 install-3.1 install-3.2 install-4.0 install-4.1
+	rsync -a --delete pool/pkgs-common $(REPO_TOP)
+
+install-%: dists/lsb-%/Release
+	mkdir -p $(REPO_TOP)/dists
+	if [ -d pool/pkgs-common ]; then rsync -r pool/pkgs-common $(REPO_TOP); fi
+	rsync -r pool/pkgs-$* $(REPO_TOP)
+	cp -r dists/lsb-$* $(REPO_TOP)/dists/lsb-$*-new
+	mv $(REPO_TOP)/dists/lsb-$* $(REPO_TOP)/dists/lsb-$*-old
+	mv $(REPO_TOP)/dists/lsb-$*-new $(REPO_TOP)/dists/lsb-$*
+	rm -rf $(REPO_TOP)/dists/lsb-$*-old
+	rsync -r --delete pool/pkgs-$* $(REPO_TOP)
+
+clean:
+	rm -f *.hi *.o missingdebs override-from-deb
+	rm -f rpmlist-* missing-* apt-overrides-*
+	rm -rf debian
+	rm -rf fakepool-*
+	rm -rf dists
+
+realclean: clean
+	rm -rf pool
+
+.PHONY: default clean realclean
+
+.SECONDARY:

=== added file 'deb/missingdebs.hs'
--- a/deb/missingdebs.hs	1970-01-01 00:00:00 +0000
+++ b/deb/missingdebs.hs	2013-06-13 02:35:11 +0000
@@ -0,0 +1,20 @@
+module Main where
+
+import Data.Maybe
+import Package
+
+showPkg :: Package -> String
+showPkg p
+    | pkgtype p == Deb
+      = "- " ++ path p
+    | pkgtype p == Rpm
+      = "+ " ++ path p
+
+missingConvertedPkg :: [Package] -> Package -> Bool
+missingConvertedPkg ps p = maybe False (\p -> notElem p ps) $ convertPkg p
+
+main :: IO ()
+main = do
+    rawList <- getContents
+    let pkgs = catMaybes $ map packageFromPath (lines rawList)
+    putStr $ unlines $ map showPkg $ filter (missingConvertedPkg pkgs) pkgs

=== added file 'deb/override-from-deb.hs'
--- a/deb/override-from-deb.hs	1970-01-01 00:00:00 +0000
+++ b/deb/override-from-deb.hs	2013-06-13 02:35:11 +0000
@@ -0,0 +1,27 @@
+module Main where
+
+import Data.Maybe
+import System.Environment
+import System.IO
+import System.Exit
+import Package
+
+writeOverride :: FilePath -> IO ()
+writeOverride path
+    | isNothing pkg
+      = do
+        hPutStrLn stderr $ "error: couldn't derive " ++ path
+        exitFailure
+    | fmap pkgtype pkg == Just Rpm
+      = do
+        hPutStrLn stderr $ "error: " ++ path ++ " is not a Debian package"
+        exitFailure
+    | otherwise
+      = putStrLn $ (name $ fromJust pkg) ++ " alien extra"
+    where pkg = packageFromPath path
+
+main :: IO ()
+main = do
+    args <- getArgs
+    if (length args) == 0 then hPutStrLn stderr "error: no filename given"
+                          else writeOverride $ head args



More information about the lsb-messages mailing list