publish: Advertise a short TTL for "baking" 404s.
* guix/scripts/publish.scm (not-found): Add #:phrase and #:ttl
parameters and honor them.
* tests/publish.scm ("with cache"): Check the 'cache-control' header on
of the 404 response.
			
			
This commit is contained in:
		
							parent
							
								
									5899fafbfe
								
							
						
					
					
						commit
						24b21720f7
					
				
					 2 changed files with 18 additions and 4 deletions
				
			
		| 
						 | 
					@ -300,10 +300,15 @@ References: ~a~%~a"
 | 
				
			||||||
                      (canonical-sexp->string (signed-string info)))))
 | 
					                      (canonical-sexp->string (signed-string info)))))
 | 
				
			||||||
    (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
 | 
					    (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (not-found request)
 | 
					(define* (not-found request
 | 
				
			||||||
 | 
					                    #:key (phrase "Resource not found")
 | 
				
			||||||
 | 
					                    ttl)
 | 
				
			||||||
  "Render 404 response for REQUEST."
 | 
					  "Render 404 response for REQUEST."
 | 
				
			||||||
  (values (build-response #:code 404)
 | 
					  (values (build-response #:code 404
 | 
				
			||||||
          (string-append "Resource not found: "
 | 
					                          #:headers (if ttl
 | 
				
			||||||
 | 
					                                        `((cache-control (max-age . ,ttl)))
 | 
				
			||||||
 | 
					                                        '()))
 | 
				
			||||||
 | 
					          (string-append phrase ": "
 | 
				
			||||||
                         (uri-path (request-uri request)))))
 | 
					                         (uri-path (request-uri request)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (render-nix-cache-info)
 | 
					(define (render-nix-cache-info)
 | 
				
			||||||
| 
						 | 
					@ -434,7 +439,9 @@ requested using POOL."
 | 
				
			||||||
                                                     (file-expiration-time ttl)
 | 
					                                                     (file-expiration-time ttl)
 | 
				
			||||||
                                                     #:delete-entry delete-entry
 | 
					                                                     #:delete-entry delete-entry
 | 
				
			||||||
                                                     #:cleanup-period ttl))))
 | 
					                                                     #:cleanup-period ttl))))
 | 
				
			||||||
           (not-found request))
 | 
					           (not-found request
 | 
				
			||||||
 | 
					                      #:phrase "We're baking it"
 | 
				
			||||||
 | 
					                      #:ttl 300))              ;should be available within 5m
 | 
				
			||||||
          (else
 | 
					          (else
 | 
				
			||||||
           (not-found request)))))
 | 
					           (not-found request)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -355,6 +355,13 @@ FileSize: ~a~%"
 | 
				
			||||||
                                       (basename %item) ".nar"))
 | 
					                                       (basename %item) ".nar"))
 | 
				
			||||||
              (response (http-get url)))
 | 
					              (response (http-get url)))
 | 
				
			||||||
         (and (= 404 (response-code response))
 | 
					         (and (= 404 (response-code response))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					              ;; We should get an explicitly short TTL for 404 in this case
 | 
				
			||||||
 | 
					              ;; because it's going to become 200 shortly.
 | 
				
			||||||
 | 
					              (match (assq-ref (response-headers response) 'cache-control)
 | 
				
			||||||
 | 
					                ((('max-age . ttl))
 | 
				
			||||||
 | 
					                 (< ttl 3600)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
              (wait-for-file cached)
 | 
					              (wait-for-file cached)
 | 
				
			||||||
              (let* ((body         (http-get-port url))
 | 
					              (let* ((body         (http-get-port url))
 | 
				
			||||||
                     (compressed   (http-get nar-url))
 | 
					                     (compressed   (http-get nar-url))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue