Changeset 2306 for trunk


Ignore:
Timestamp:
Aug 18, 2012, 1:03:46 PM (12 years ago)
Author:
ezyang
Message:
Don't starve non-find commands, handle concurrent writes to file.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/server/common/oursrc/hsparfind/hsparfind.hs

    r2305 r2306  
    7373    last . lines <$> readFile (base </> ".scripts-version")
    7474
    75 writeOut cn base r = do
    76     let line = base ++ ":" ++ r ++ "\n"
    77     putStr line
    78     appendFile (destdir </> cn) line
     75writeOut handle_mvar base r =
     76    withMVar handle_mvar $ \handle -> do
     77        let line = base ++ ":" ++ r ++ "\n"
     78        putStr line
     79        hPutStr handle line
    7980
    8081exec :: TVar Int -> String -> [String] -> IO String
    … …  
    103104
    104105parfind = 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
    106108    children <- newMVar []
    107109    userlines <- lines <$> readFile "/mit/scripts/admin/backup/userlist"
    … …  
    113115                 $  userlines
    114116    forM_ userdirs $ \(cn, homedir) -> forkChild children $ do
     117        subchildren <- newMVar []
    115118        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
    123129    waitForChildren children
Note: See TracChangeset for help on using the changeset viewer.