[darcs-devel] darcs patch

Juliusz Chroboczek jch at pps.jussieu.fr
Wed Jun 30 12:52:47 PDT 2004


--aaack


Wed Jun 30 21:19:50 CEST 2004  Juliusz Chroboczek <jch at pps.jussieu.fr>
  * Use a new datatype instead of Bool for cachability.

Wed Jun 30 21:50:02 CEST 2004  Juliusz Chroboczek <jch at pps.jussieu.fr>
  * Make prefs cachable for 10 minutes.
  If using a cache, this avoids the overhead of hitting the remote
  server for every file in prefs when doing multiple gets in quick
  succession.  Would a smaller value be better?


--aaack
Content-Type: text/x-darcs-patch
Content-Description: A darcs patch for your repository!


New patches:

[Use a new datatype instead of Bool for cachability.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040630191950] 
<
> {
hunk ./Curl.hs 1
-module Curl ( readUrlPS, copyUrl ) where
+module Curl ( readUrlPS, copyUrl, Cachable(Cachable, Uncachable) ) where
 
 import IO
 #ifdef HAVE_CURL
hunk ./Curl.hs 12
 import FastPackedString ( PackedString, readFilePS )
 import Lock ( withTemp )
 
-readUrlPS :: String -> Bool -> IO PackedString
-readUrlPS u nocache = withTemp $ \tf -> do copyUrl u tf nocache
-                                           readFilePS tf
+data Cachable = Cachable | Uncachable
 
hunk ./Curl.hs 14
-copyUrl :: String -> String -> Bool -> IO ()
+readUrlPS :: String -> Cachable -> IO PackedString
+readUrlPS u cache = withTemp $ \tf -> do copyUrl u tf cache
+                                         readFilePS tf
+
+copyUrl :: String -> String -> Cachable -> IO ()
 #ifdef HAVE_CURL
hunk ./Curl.hs 20
-copyUrl u f nocache =
+copyUrl u f cache =
   withCString u $ \ustr ->
   withCString f $ \fstr -> do
hunk ./Curl.hs 23
-  err <- get_curl fstr ustr (if nocache then 1 else 0)
+  err <- get_curl fstr ustr (cachableToInt cache)
   when (err /= 0) $ fail $ "Failed to download URL "++ u ++ curl_e err
       where curl_e 1 = "libcurl: unsupported protocol"
             curl_e 3 = "libcurl: malformed URL"
hunk ./Curl.hs 37
 #endif
 
 #ifdef HAVE_CURL
+cachableToInt :: Cachable -> Int
+cachableToInt Cachable = 0
+cachableToInt Uncachable = 1
+
 foreign import ccall "hscurl.h get_curl"
   get_curl :: CString -> CString -> Int -> IO Int
 #endif
hunk ./External.hs 10
     execPipe, execPipeIgnoreError,
     getTermNColors,
     pipeSSH_IgnoreError,
+    Cachable( Cachable, Uncachable )
   ) where
 
 import List ( intersperse )
hunk ./External.hs 36
 import Lock ( withTemp, withOpenTemp, readBinFile, canonFilename, writeBinFile )
 import Autoconf ( have_libcurl, have_sendmail, have_mapi, sendmail_path, use_color )
 import Curl ( readUrlPS, copyUrl )
+import Curl ( Cachable(..) )
 import Exec ( exec )
 import DarcsURL ( is_file, is_url )
 import DarcsUtils ( catchall )
hunk ./External.hs 42
 #include "impossible.h"
 
-fetchFilePS :: String -> Bool -> IO PackedString
+fetchFilePS :: String -> Cachable -> IO PackedString
 fetchFilePS fou _ | is_file fou = readFilePS fou
hunk ./External.hs 44
-fetchFilePS fou nocache = readRemotePS fou nocache
+fetchFilePS fou cache = readRemotePS fou cache
 
hunk ./External.hs 46
-gzFetchFilePS :: String -> Bool -> IO PackedString
-gzFetchFilePS fou nocache = withTemp $ \t-> do copyFileOrUrl fou t nocache
-                                               gzReadFilePS t
+gzFetchFilePS :: String -> Cachable -> IO PackedString
+gzFetchFilePS fou cache = withTemp $ \t-> do copyFileOrUrl fou t cache
+                                             gzReadFilePS t
 
hunk ./External.hs 50
-copyRemote :: String -> FilePath -> Bool -> IO ()
-copyRemote u v nocache | is_url u = if have_libcurl
-                                    then Curl.copyUrl u v nocache
-                                    else copyRemoteCmd u v
+copyRemote :: String -> FilePath -> Cachable -> IO ()
+copyRemote u v cache | is_url u = if have_libcurl
+                                  then Curl.copyUrl u v cache
+                                  else copyRemoteCmd u v
 copyRemote u v _ = copySSH u v
 
 copyRemoteCmd :: String -> FilePath -> IO ()
hunk ./External.hs 91
           return f
                      `catch` (\_ -> try_cmd cs)
 
-readRemotePS :: String -> Bool -> IO PackedString
-readRemotePS s nocache | is_url s =
- if have_libcurl then readUrlPS s nocache
+readRemotePS :: String -> Cachable -> IO PackedString
+readRemotePS s cache | is_url s =
+ if have_libcurl then readUrlPS s cache
  else
   withTemp $ \tmp -> do
     copyRemoteCmd s tmp
hunk ./External.hs 133
   withTemp $ \tmp -> do copySSH path tmp
                         readFilePS tmp
 
-copyFileOrUrl :: FilePath -> FilePath -> Bool -> IO ()
+copyFileOrUrl :: FilePath -> FilePath -> Cachable -> IO ()
 copyFileOrUrl fou out _ | is_file fou =
     createLink fou out `catchall` do c <- readFilePS fou
                                      writeFilePS out c
hunk ./External.hs 137
-copyFileOrUrl fou out nocache = copyRemote fou out nocache
+copyFileOrUrl fou out cache = copyRemote fou out cache
 
 
 sendEmail :: String -> String -> String -> String -> String -> IO ()
hunk ./Get.lhs 40
                   )
 import Patch ( apply_to_slurpy, patch2patchinfo, invert )
 import SlurpDirectory ( slurp_write, slurp_write_dirty, empty_slurpy )
-import External ( copyFileOrUrl )
+import External ( copyFileOrUrl, Cachable(..) )
 import Depends ( get_common_and_uncommon )
 import RepoPrefs ( set_lastrepo, write_default_prefs, show_motd )
 import Match ( have_patchset_match, get_one_patchset )
hunk ./Get.lhs 128
      then do
        s <- slurp_recorded repodir
        copyFileOrUrl
-          (repodir++"/_darcs/prefs/prefs") "_darcs/prefs/prefs" True
+          (repodir++"/_darcs/prefs/prefs") "_darcs/prefs/prefs" Uncachable
           `catchall` return ()
        slurp_write s
        s' <- slurp_recorded repodir
hunk ./RepoPrefs.lhs 38
 import System ( getEnv )
 
 import DarcsFlags ( DarcsFlag( Quiet ) )
-import External ( fetchFilePS )
+import External ( fetchFilePS, Cachable(..) )
 import FastPackedString ( unpackPS )
 import Lock ( writeBinFile, readBinFile )
 import DarcsUtils ( catchall )
hunk ./RepoPrefs.lhs 270
 \begin{code}
 show_motd :: [DarcsFlag] -> String -> IO ()
 show_motd opts repo = do
-  motd <- (unpackPS `liftM` fetchFilePS (repo++"/_darcs/prefs/motd") True)
+  motd <- (unpackPS `liftM`
+               fetchFilePS (repo++"/_darcs/prefs/motd") Uncachable)
            `catchall` return ""
   unless (motd == "" || Quiet `elem` opts) $ do putStr motd
                                                 putStr "**********************\n"
hunk ./Repository.lhs 92
                    human_friendly,
                  )
 import Diff ( smart_diff, sync )
-import External ( gzFetchFilePS, fetchFilePS, copyFileOrUrl )
+import External ( gzFetchFilePS, fetchFilePS, copyFileOrUrl, Cachable(..) )
 import Lock ( writeBinFile, appendBinFile )
 import DarcsFlags ( DarcsFlag(Verbose, AnyOrder, NoCompress,
                               WorkDir, LookForAdds, Boring,
hunk ./Repository.lhs 341
   sequence_ $ map (\pn -> do putVorDot $ "Copying "++pn++"\n"
                              copyFileOrUrl
                                (realdir++"/_darcs/patches/"++pn)
-                               (out++"/_darcs/patches/"++pn) False)
+                               (out++"/_darcs/patches/"++pn) Cachable)
                   pns
   finishDots
       where putInfo s = when (not $ Quiet `elem` opts) $ putStr s
hunk ./Repository.lhs 369
 
 read_repo_private :: FilePath -> FilePath -> IO PatchSet
 read_repo_private d iname = do
-    i <- fetchFilePS (d++"/_darcs/"++iname) True
+    i <- fetchFilePS (d++"/_darcs/"++iname) Uncachable
     (rest,str) <- case breakOnPS '\n' i of
                   (swt,pistr) | swt == packString "Starting with tag:" ->
                     do r <- rr $ head $ read_patch_ids pistr
hunk ./Repository.lhs 385
                      "inventories/"++make_filename pinfo
 read_patch :: String -> PatchInfo -> IO Patch
 read_patch repo i = do
-  s <- gzFetchFilePS pn False
+  s <- gzFetchFilePS pn Cachable
   case readPatchPS s of
     Just (p,_) -> return p
     Nothing -> fail $ "couldn't read "++pn
hunk ./Repository.lhs 401
 read_patches_remote dir (i:is) = do
   mp <- unsafeInterleaveIO $
         do s <- gzFetchFilePS 
-                    (dir++"/_darcs/patches/"++make_filename i) False
+                    (dir++"/_darcs/patches/"++make_filename i) Cachable
            return $ fst `liftM` (readPatchPS s)
          `catch` \_ -> return Nothing
   rest <- read_patches_remote dir is
hunk ./Repository.lhs 437
 read_checkpoints :: String -> IO [(PatchInfo, Maybe Slurpy)]
 read_checkpoints d = do
   realdir <- absolute_dir d
-  pistr <- fetchFilePS (realdir++"/_darcs/checkpoints/inventory") True
+  pistr <- fetchFilePS (realdir++"/_darcs/checkpoints/inventory") Uncachable
            `catchall` (return $ packString "")
   pis <- return $ reverse $ read_patch_ids pistr
   slurpies <- sequence $ map (fetch_checkpoint realdir) pis
hunk ./Repository.lhs 445
       where fetch_checkpoint r pinfo =
                 unsafeInterleaveIO $ do
                 pstr <- gzFetchFilePS  
-                    (r++"/_darcs/checkpoints/"++make_filename pinfo) False
+                    (r++"/_darcs/checkpoints/"++make_filename pinfo) Cachable
                 case fst `liftM` readPatchPS pstr of
                   Nothing -> return Nothing
                   Just p -> return $ apply_to_slurpy p empty_slurpy
hunk ./Repository.lhs 462
 
 get_check_internal :: String -> IO (Maybe Patch)
 get_check_internal r = do
-  pistr <- fetchFilePS (r++"/_darcs/checkpoints/inventory") True
+  pistr <- fetchFilePS (r++"/_darcs/checkpoints/inventory") Uncachable
            `catchall` (return $ packString "")
   case reverse $ read_patch_ids pistr of
     [] -> return Nothing
hunk ./Repository.lhs 468
     (pinfo:_) -> ((fst `liftM`). readPatchPS) `liftM`
                  gzFetchFilePS
-                     (r++"/_darcs/checkpoints/"++make_filename pinfo) False
+                     (r++"/_darcs/checkpoints/"++make_filename pinfo) Cachable
 
 format_inv :: [PatchInfo] -> String
 format_inv [] = ""
hunk ./Send.lhs 44
              )
 import PatchInfo ( human_friendly )
 import RepoPrefs ( lastrepo, set_lastrepo, get_preflist )
-import External ( signString, sendEmail, fetchFilePS )
+import External ( signString, sendEmail, fetchFilePS, Cachable(..) )
 import FastPackedString ( unpackPS, mmapFilePS )
 import Lock ( writeBinFile, withLock )
 import SelectChanges ( with_selected_changes )
hunk ./Send.lhs 214
           who_to_email =
               do email <- (unpackPS `liftM`
                            fetchFilePS (remote_repo++"/_darcs/prefs/email")
-                                       True)
+                                       Uncachable)
                           `catchall` return ""
                  if '@' `elem` email then return $ lines email
                                      else return []
}

[Make prefs cachable for 10 minutes.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040630195002
 If using a cache, this avoids the overhead of hitting the remote
 server for every file in prefs when doing multiple gets in quick
 succession.  Would a smaller value be better?
] 
<
> {
hunk ./Curl.hs 1
-module Curl ( readUrlPS, copyUrl, Cachable(Cachable, Uncachable) ) where
+module Curl ( readUrlPS, copyUrl, Cachable(Cachable, Uncachable, MaxAge) ) 
+where
 
 import IO
 #ifdef HAVE_CURL
hunk ./Curl.hs 13
 import FastPackedString ( PackedString, readFilePS )
 import Lock ( withTemp )
 
-data Cachable = Cachable | Uncachable
+data Cachable = Cachable | Uncachable | MaxAge !Int
 
 readUrlPS :: String -> Cachable -> IO PackedString
 readUrlPS u cache = withTemp $ \tf -> do copyUrl u tf cache
hunk ./Curl.hs 39
 
 #ifdef HAVE_CURL
 cachableToInt :: Cachable -> Int
-cachableToInt Cachable = 0
-cachableToInt Uncachable = 1
+cachableToInt Cachable = -1
+cachableToInt Uncachable = 0
+cachableToInt (MaxAge n) = n
 
 foreign import ccall "hscurl.h get_curl"
   get_curl :: CString -> CString -> Int -> IO Int
hunk ./External.hs 10
     execPipe, execPipeIgnoreError,
     getTermNColors,
     pipeSSH_IgnoreError,
-    Cachable( Cachable, Uncachable )
+    Cachable(Cachable, Uncachable, MaxAge)
   ) where
 
 import List ( intersperse )
hunk ./Get.lhs 128
      then do
        s <- slurp_recorded repodir
        copyFileOrUrl
-          (repodir++"/_darcs/prefs/prefs") "_darcs/prefs/prefs" Uncachable
+          (repodir++"/_darcs/prefs/prefs") "_darcs/prefs/prefs" (MaxAge 600)
           `catchall` return ()
        slurp_write s
        s' <- slurp_recorded repodir
hunk ./RepoPrefs.lhs 271
 show_motd :: [DarcsFlag] -> String -> IO ()
 show_motd opts repo = do
   motd <- (unpackPS `liftM`
-               fetchFilePS (repo++"/_darcs/prefs/motd") Uncachable)
+               fetchFilePS (repo++"/_darcs/prefs/motd") (MaxAge 600))
            `catchall` return ""
   unless (motd == "" || Quiet `elem` opts) $ do putStr motd
                                                 putStr "**********************\n"
hunk ./Send.lhs 214
           who_to_email =
               do email <- (unpackPS `liftM`
                            fetchFilePS (remote_repo++"/_darcs/prefs/email")
-                                       Uncachable)
+                                       (MaxAge 600))
                           `catchall` return ""
                  if '@' `elem` email then return $ lines email
                                      else return []
hunk ./hscurl.c 14
 static int curl_init_done = 0;
 
 // get_curl returns an error code
-int get_curl(const char *filename, const char *url, int nocache) {
+// cache_time is -1 for default cachability
+int get_curl(const char *filename, const char *url, int cache_time) {
   CURLcode err;
   FILE *f;
   struct curl_slist *headers = NULL;
hunk ./hscurl.c 38
      Cache-Control, which is contradictory.  We override both, just to
      be sure. */
   headers = curl_slist_append(headers, "Accept: */*");
-  if(nocache) {
+  if(cache_time == 0) {
       headers = curl_slist_append(headers, "Pragma: no-cache");
       headers = curl_slist_append(headers, "Cache-Control: no-cache");
hunk ./hscurl.c 41
+  } else if(cache_time > 0) {
+      /* This won't work well with HTTP/1.0 proxies. */
+      char buf[40];
+      snprintf(buf, 40, "Cache-Control: max-age=%d", cache_time);
+      headers = curl_slist_append(headers, "Pragma:");
+      headers = curl_slist_append(headers, buf);
   } else {
       headers = curl_slist_append(headers, "Pragma:");
       headers = curl_slist_append(headers, "Cache-Control:");
hunk ./hscurl.h 1
-int get_curl(const char *filename, const char *url, int nocache);
+int get_curl(const char *filename, const char *url, int cache_time);
 
}



Context:

[allow --dry-run push where push would fail.
David Roundy <droundy at abridgegame.org>**20040630102058] 
[fix compile error when there's no libcurl.
David Roundy <droundy at abridgegame.org>**20040630101253] 
[fix MOTD conflict with cached files change.
David Roundy <droundy at abridgegame.org>**20040630090529] 
[Add cache control directives to HTTP requests.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040629125723
 Mark requests for inventories as uncachable, requests for patches as
 cachable.
 
 This is only implemented for libcurl.  When spawning curl or wget, all
 requests are marked uncachable (untested).
] 
[make revert work properly when file is given on command line and there are pending adds/removes.
David Roundy <droundy at abridgegame.org>**20040630100836] 
[make changes --context give less extraneous information.
David Roundy <droundy at abridgegame.org>**20040629104642] 
[fix weird error with --last.
David Roundy <droundy at abridgegame.org>**20040629101457] 
[fix bug in get --tag.
David Roundy <droundy at abridgegame.org>**20040629100405
 I was a good boy and also added a test so this won't happen again... at
 least not with this particular command.
] 
[add support for a MOTD.
David Roundy <droundy at abridgegame.org>**20040629094631] 
[update changelog.
David Roundy <droundy at abridgegame.org>**20040629094401] 
[move DarcsFlag data structure into its own module.
David Roundy <droundy at abridgegame.org>**20040629094218
 This is to work around circular dependency issues.
] 
[point darcsrv product link at darcs homepage
Will <will at glozer.net>**20040628233035] 
[match new <move> tag instead of <move_file>
Will <will at glozer.net>**20040628232426] 
[Use lock directory for temporary lock file.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20040628190720
 This avoids lock creation failing with EXDEV when the repository
 directory and _darcs are not on the same filesystem (e.g. _darcs is
 softlinked).  I hate users.
] 
[support --context option in send.
David Roundy <droundy at abridgegame.org>**20040628102624] 
[add support for a --last option to specify last N changes.
David Roundy <droundy at abridgegame.org>**20040628095805
 This has only been tested so far with diff and changes...
] 
[update and reprioritize TODO.
David Roundy <droundy at abridgegame.org>**20040628091216] 
[Merge debian/ directory with 0.9.22
Gabriel Ebner <ge at gabrielebner.at>**20040627212437] 
[correction on send help.
David Roundy <droundy at abridgegame.org>**20040627093056] 
[Add warning to 'darcs remove' help
Jim Marshall <jmarshall99 at qwest.net>**20040626220417] 
[Small 'command -h' typo fixes and clarifications.
Jim Marshall <jmarshall99 at qwest.net>**20040626212642] 
[fix happy-forwarding to not include nasty long header.
droundy at civet.berkeley.edu**20040627121954
 The catch is that all headers are lost now when the mail is resent, so this
 may make it harder to track down what went wrong if something does go
 wrong.
] 
[Minor doc fixes
Nigel Rowe <rho at swiftdsl.com.au>**20040627035455] 
[work around stupid bug in old autoconfs.
droundy at civet.berkeley.edu**20040627104351] 
[fix up happ-forwarding (hopefully).
David Roundy <droundy at abridgegame.org>**20040627092644] 
[increase laziness of diff_from_empty.
David Roundy <droundy at abridgegame.org>**20040626140020
 I believe this reduces the memory usage of initial records (or whenever
 lots of files are added) and optimize --checkpoint by about a factor of
 four, although I haven't yet tested it on a seriously large repository.
] 
[TAG 0.9.22
David Roundy <droundy at abridgegame.org>**20040626123533] 

Patch bundle hash:
4e414bbe03817c32805ad6f37c5be76337121282

--aaack

--aaack--





More information about the darcs-devel mailing list