Changeset 2306 for trunk/server
- Timestamp:
- Aug 18, 2012, 1:03:46 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/server/common/oursrc/hsparfind/hsparfind.hs
r2305 r2306 73 73 last . lines <$> readFile (base </> ".scripts-version") 74 74 75 writeOut cn base r = do 76 let line = base ++ ":" ++ r ++ "\n" 77 putStr line 78 appendFile (destdir </> cn) line 75 writeOut handle_mvar base r = 76 withMVar handle_mvar $ \handle -> do 77 let line = base ++ ":" ++ r ++ "\n" 78 putStr line 79 hPutStr handle line 79 80 80 81 exec :: TVar Int -> String -> [String] -> IO String … … 103 104 104 105 parfind = do 105 pool <- newTVarIO 40 -- number of child subprocesses to spawn simultaneously 106 findpool <- newTVarIO 50 107 pool <- newTVarIO 10 -- git/fs gets its own pool so they don't starve 106 108 children <- newMVar [] 107 109 userlines <- lines <$> readFile "/mit/scripts/admin/backup/userlist" … … 113 115 $ userlines 114 116 forM_ userdirs $ \(cn, homedir) -> forkChild children $ do 117 subchildren <- newMVar [] 115 118 let scriptsdir = homedir </> "web_scripts" 116 matches <- lines <$> exec pool "find" [scriptsdir, "-xdev", "-name", ".scripts-version", "-o", "-name", ".scripts"] 117 forM_ matches $ \dir -> forkIO . handle (\(SomeException e) -> putStrLn (dir ++ ": " ++ show e)) $ do 118 let base = takeDirectory dir 119 whenM (checkPerm pool base) $ do 120 if ".scripts" `isSuffixOf` dir 121 then newVersion pool cn base >>= writeOut cn base 122 else whenM (not <$> doesDirectoryExist (base </> ".scripts")) $ oldVersion base >>= writeOut cn base 119 matches <- lines <$> exec findpool "find" [scriptsdir, "-xdev", "-name", ".scripts-version", "-o", "-name", ".scripts"] 120 withFile (destdir </> cn) WriteMode $ \h -> do 121 mh <- newMVar h 122 forM_ matches $ \dir -> forkChild subchildren . handle (\(SomeException e) -> putStrLn (dir ++ ": " ++ show e)) $ do 123 let base = takeDirectory dir 124 whenM (checkPerm pool base) $ do 125 if ".scripts" `isSuffixOf` dir 126 then newVersion pool cn base >>= writeOut mh base 127 else whenM (not <$> doesDirectoryExist (base </> ".scripts")) $ oldVersion base >>= writeOut mh base 128 waitForChildren subchildren 123 129 waitForChildren children
Note: See TracChangeset
for help on using the changeset viewer.