cache_req_fsm: keep the cache object's Content-Length for HEAD always

Previously, we would only keep the Content-Length header for HEAD requests on
hit-for-miss objects, now we simply keep it always to enable "fallback" caching
of HEAD requests.

The added vtc implements the basics of the logic to enable the (reasonable) use
case documented in
#2107 (comment)
but using Vary instead of cache key modification plus restart.

Fixes #4245

bin/varnishd/cache/cache_req_fsm.c

@@ -484,15 +484,12 @@ cnt_transmit(struct worker *wrk, struct req *req)
 			http_Unset(req->resp, H_Content_Length);
 		} else if (clval >= 0 && clval == req->resp_len) {
 			/* Reuse C-L header */
-		} else if (head && req->objcore->flags & OC_F_HFM) {
-			/*
-			 * Don't touch C-L header (debatable)
-			 *
-			 * The only way to do it correctly would be to GET
-			 * to the backend, and discard the body once the
-			 * filters have had a chance to chew on it, but that
-			 * would negate the "pass for huge objects" use case.
+		} else if (head) {
+			/* rfc9110,l,3226,3227
+			 * "MAY send Content-Length ... [for] HEAD"
+			 * do not touch to support cached HEAD #4245
 			 */
+			req->resp_len = 0;
 		} else {
 			http_Unset(req->resp, H_Content_Length);
 			if (req->resp_len >= 0)

bin/varnishtest/tests/r04245.vtc

@@ -0,0 +1,77 @@
+varnishtest "cache a HEAD as a fallback for a GET"
+
+server s1 {
+	rxreq
+	expect req.method == "HEAD"
+	expect req.http.t == "headmiss"
+	txresp -nolen -hdr "Content-Length: 42"
+
+	rxreq
+	expect req.method == "GET"
+	expect req.http.t == "getmiss"
+	txresp -bodylen 42
+} -start
+
+varnish v1 -vcl+backend {
+    sub vcl_recv {
+	if (req.method == "HEAD") {
+	    set req.http.X-Fetch-Method = "HEAD";
+	} else {
+	    unset req.http.X-Fetch-Method;
+	}
+    }
+
+    sub vcl_backend_fetch {
+	if (bereq.http.X-Fetch-Method) {
+	    set bereq.method = bereq.http.X-Fetch-Method;
+	}
+    }
+
+    sub vcl_backend_response {
+	# NOTE: this use of Vary is specific to this case, it is
+	# usually WRONG to only set Vary for a specific condition
+	if (bereq.http.X-Fetch-Method) {
+	    if (beresp.http.Vary) {
+		set beresp.http.Vary += ", X-Fetch-Method";
+	    } else {
+		set beresp.http.Vary = "X-Fetch-Method";
+	    }
+	}
+	set beresp.http.t = bereq.http.t;
+    }
+
+    sub vcl_deliver {
+	# Vary cleanup
+	if (resp.http.Vary == "X-Fetch-Method") {
+	    unset resp.http.Vary;
+	} else if (resp.http.Vary ~ ", X-Fetch-Method$") {
+	    set resp.http.Vary =
+		regsub(resp.http.Vary, ", X-Fetch-Method$", "");
+	}
+    }
+} -start
+
+client c1 {
+	# miss
+	txreq -method "HEAD" -hdr "t: headmiss"
+	rxresphdrs
+	expect resp.http.t == "headmiss"
+	# hit
+	txreq -method "HEAD" -hdr "t: headhit"
+	rxresphdrs
+	expect resp.http.t == "headmiss"
+
+	# miss
+	txreq -hdr "t: getmiss"
+	rxresp
+	expect resp.http.t == "getmiss"
+	# hits on full object
+	txreq -hdr "t: gethit"
+	rxresp
+	expect resp.http.t == "getmiss"
+	txreq -method "HEAD" -hdr "t: getheadhit"
+	rxresphdrs
+	expect resp.http.t == "getmiss"
+} -run
+
+server s1 -wait