File: Builder.hs

package info (click to toggle)
srcinst 0.8.8
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 88 kB
  • ctags: 5
  • sloc: haskell: 223; makefile: 102
file content (152 lines) | stat: -rw-r--r-- 6,897 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
{- arch-tag: main builder
Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Builder where
import MissingH.Logging.Logger
import MissingH.Debian
import MissingH.Debian.ControlParser
import MissingH.Either
import MissingH.Cmd
import System.Cmd
import System.Exit
import Dpkg
import Utils
import Text.ParserCombinators.Parsec
import MissingH.Str
import Control.Monad

buildOrInstall :: String -> IO ()

buildOrInstall packagename = 
    do infoM "" $ "buildOrInstall: Processing " ++ packagename
       installed <- getInstalledVer packagename
       avail <- getAvailableVer packagename
       infoM "" $ show (installed, avail)
       case (installed, avail) of
         (Nothing, Nothing) -> fail $ 
                           packagename ++ " is not available in source form"
         (Just _, Nothing) -> infoM "" $ packagename ++ " is already installed, and does not exist in source form"
         (Nothing, Just x) -> buildOrInstallRunner packagename x
         (Just inst, Just avail) -> 
             do c <- compareDebVersion inst avail
                if c /= LT
                   then infoM "" $ packagename ++ " " ++ inst ++
                                   " is already installed, and there is no newer version"
                   else buildOrInstallRunner packagename avail

-- Install from cache, or build
buildOrInstallRunner packagename version =
    do debugM "" $ "buildOrInstallRunner: " ++ packagename ++ " " ++ version
       hc <- hascache packagename version
       if hc
          then installcache packagename version
          else do build packagename
                  installcache packagename version

hascache packagename version =
    do infoM "" $ "hascache: testing " ++ pkgVerToFilename packagename version
       rc <- rawSystem "bash" ["-c", "test -f " ++  pkgVerToFilename packagename version]
       case rc of
               ExitSuccess -> do debugM "" "hascache returning True"
                                 return True
               ExitFailure _ -> do debugM "" "hascache returnung False"
                                   return False
               
build packagename =
    do infoM "" $ "Beginning build of " ++ packagename
       procBuildDeps packagename
       safeSystem "apt-get" ["-b", "source", packagename]

installcache packagename version =
    do infoM "" $ "Scanning deps for " ++ packagename ++ " " ++ version
       procDebDeps packagename version
       infoM "" $ "Installing " ++ packagename ++ " " ++ version
       safeSystem "bash" ["-c", "dpkg -i " ++ (pkgVerToFilename packagename version)]

procDebDeps packagename version =
    do d <- getDebDeps packagename version
       procDeps d

procDeps deplist =
    -- Returns True if a package could be installed, or False otherwise.
    let procPkg :: (String, Maybe (String, String)) -> IO Bool
        procPkg (pkg, Nothing) = do installed <- getInstalledVer pkg
                                    case installed of
                                      Nothing -> do buildOrInstall pkg
                                                    return True
                                      Just _ -> return True
        procPkg (pkg, Just (op, ver)) =
            do installed <- getInstalledVer pkg
               avail <- getAvailableVer pkg
               debugM "" $ "procpkg: running " ++ pkg ++ " " ++
                           show (op, ver) ++
                           show (installed, avail)
               case (installed, avail) of
                  (Nothing, Nothing) -> do infoM "" $ "No package for dependency " ++ pkg ++ " is available"
                                           return False
                  (Just i, Nothing) -> 
                      do dv <- checkDebVersion i op ver
                         if dv
                            then return True
                            else do infoM "" $ "No package in sufficient version for dependency " ++ pkg ++ " is available"
                                    return False
                  (Nothing, Just x) -> 
                      do dv <- checkDebVersion x op ver
                         if dv
                            then do buildOrInstallRunner pkg x
                                    return True
                            else do infoM "" $ "No package in sufficient source version for dependyncy " ++ pkg
                                    return False
                  (Just x, Just y) -> 
                      do dv <- checkDebVersion x op ver
                         if dv
                            then do debugM "" $ pkg ++ " installed OK already"
                                    return True
                            else do debugM "" $ pkg ++ " not installed OK already"
                                    dv2 <- checkDebVersion y op ver
                                    if dv2
                                       then do buildOrInstallRunner pkg  y
                                               return True
                                       else do infoM "" $ "No package in sufficient source version for dep " ++ pkg
                                               return False

        procSpecificDep True _ = return True -- dep already satisfied
        procSpecificDep False (package, version, _) = 
            procPkg (package, version)
        splitdeps = map strip . split "|"
        procThisDep dep =
            do myarch <- getArch
               debugM "" $ "procThisDep: my arch is " ++ myarch
               let deplist = splitdeps dep
               let parsedeplist = map 
                                   (\x -> forceEither .
                                    parse depPart x $ x) deplist
               let filteredlist = 
                       filter (\(_, _, archlist) -> archlist == [] || elem myarch archlist) parsedeplist
               case filteredlist of
                [] -> return ()
                _ -> do r <- foldM procSpecificDep False filteredlist
                        if r
                           then return ()
                           else fail "Failed to meet all deps"
    in
    mapM_ procThisDep deplist

procBuildDeps packagename =
    do bd <- getBuildDeps packagename
       procDeps bd