<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w

# Reads cache.log and displays lines that correspond to the master transaction
# that has a given async job. Master transaction is all activities tied to a
# a single received HTTP request (client side, ACL, ICAP, server side, etc.).
#
# See trace-job.pl for tracing a single job instead of all jobs related to
# a master transaction.
#
# Currently, many master transaction activities are not tracked because they
# do not use AsyncJob API. Eventually, most activities should be identifiable.
#
# Currently, the script reads and remembers all master transactions because it
# does not know which one should be tracked in advance. Eventually, we may
# have a more efficient way of tying master transaction to a job.
# 


use strict;
use warnings;

my @InterestingJobs = @ARGV or die("usage: $0 &lt;job id&gt; ...\n");

my %Jobs = ();

my $inside = 0;
my $entering;

while (&lt;STDIN&gt;) {
	$entering = $_ if !$inside &amp;&amp; /\| entering\b/;
	undef $entering if /\| leaving\b/;

	if (!$inside &amp;&amp; /\bstatus in\b.*\b(?:async|job|icapx)(\d+)\b/o) {
		$inside = $1;
		&amp;enterJob($inside);
		&amp;updateJob($inside, $entering) if defined $entering;
		undef $entering;
	} 
	elsif (!$inside &amp;&amp; /\b(?:async|job|icapx)(\d+)\b/o) {
		updateJob($1, "$_\n"); # isolated line
	}

	next unless $inside;	

	&amp;updateJob($inside, $_);

	if (/AsyncJob constructed.*\[\S+?(\d+)\]/) {
		&amp;linkJobs($inside, $1, $_);
	}
	
	if (/\| leaving\b/) {
		$inside = 0;
	}
}

foreach my $id (@InterestingJobs) {
	# Squid uses asyncNNN, jobNNN, icapxNNN for the same job/transaction
	$id =~ s/^(?:async|job|icapx)(\d+)$/$1/;
	reportJob($id, 1);
}

exit(0);



sub enterJob {
	my ($id) = @_;
	my $job = &amp;getJob($id);
}

sub updateJob {
	my ($id, $line) = @_;

	my $job = &amp;getJob($id);
	$job-&gt;{history} .= $line;

	if ($line =~ /\bFD (\d+)/) {
		$job-&gt;{fds}-&gt;{$1} = 1;
	}
}

sub linkJobs {
	my ($parentId, $kidId, $line) = @_;

	my $parent = $Jobs{$parentId} or die("missing linked job $parentId");
	push @{$parent-&gt;{kids}}, $kidId;
	
	my $kid = &amp;getJob($kidId);
	die("two parents for $kidId: ". $kid-&gt;{parent}. " and $parentId") if $kid-&gt;{parent};
	$kid-&gt;{parent} = $parentId;

	$kid-&gt;{history} .= $line; # birth
}

sub getJob {
	my $id = shift;

	my $job = $Jobs{$id};
	return $job if $job;

	$job = {
		id =&gt; $id,
		kids =&gt; [],
		fds =&gt; {},
		parent =&gt; undef(),

		start =&gt; undef(),
		history =&gt; '',

		reported =&gt; 0,
	};

	$Jobs{$id} = $job;
	return $job;
}


sub reportJob {
	my ($id, $recursive) = @_;

	my $job = $Jobs{$id} or die("Did not see job$id\n");

	# several kids may try to report their common parent
	return if $job-&gt;{reported};
	$job-&gt;{reported} = 1;

	&amp;reportJob($job-&gt;{parent}, 0) if $job-&gt;{parent};

	&amp;reportJobParam($id, 'parent');
	&amp;reportJobParam($id, 'kids', join(', ', @{$job-&gt;{kids}}));
	&amp;reportJobParam($id, 'FDs', join(', ', keys %{$job-&gt;{fds}}));
	&amp;reportJobHistory($id);

	return unless $recursive;

	foreach my $kidId (@{$job-&gt;{kids}}) {
		&amp;reportJob($kidId, $recursive);
	}
}

sub reportJobParam {
	my ($id, $name, $value) = @_;
	my $job = $Jobs{$id} or die;

	$value = $job-&gt;{$name} if @_ &lt; 3;
	$value = '?' unless defined $value;
	$value = "\n$value" if $value =~ /\n/m;
	printf("job%d %s: %s\n", $id, $name, $value);
}

sub reportJobHistory {
	my ($id) = @_;
	my $job = $Jobs{$id} or die;

	my $history = $job-&gt;{history};
	my @lines = split(/\n/, $history);
	&amp;reportJobParam($id, 'history', (scalar @lines) . " entries");

	foreach my $line (@lines) {
		print "$line\n";
		print "\n" if $line =~ /\| leaving\b/;
	}
}
</pre></body></html>