#!/usr/bin/perl # # This is a X11 replay program. It will replay a session using # the timestamps from the packet log, and transpose the X11 protocol so # that it can be redisplayed. You must have captured from the start # of the connection for this to work. # # USAGE: ./session_0001.X11.replay [-d destination host] [-p port] factor # # just run the script as normal. You can provide a factor as an # argument, eg "2" to run twice as fast, or "0.5" to run # at half time. eg, # ./session_0002.X11.replay 2 # a different host and port can be specified if needed. eg, # ./session_0002.X11.replay -d 192.168.1.5 -p 6001 # # PROBLEMS: you may need to authorise this connection to the X11 server # before it works. You could run "xhost +hostname" beforehand. # The playback needs to have captured the start of the connection. # Check you support the same colour depth as the playback. And check # the playback file simply isn't too big! (more than 500 Kb is # currently problematic). # # # Auto generated by Chaosreader. # use IO::Socket; use Getopt::Std; if ($ARGV[0] =~ /^-h$|^--help$/) { &help(); } # Try fetching values from $DISPLAY ($hostdef,$portdef) = $ENV{DISPLAY} =~ /([^:]*):(\d*)/; $hostdef = "127.0.0.1" if $hostdef eq ""; $portdef += 6000; # Command line options take preference &getopts('d:p:'); if (defined $opt_d) { $host = $opt_d; } else { $host = $hostdef; } if (defined $opt_p) { $port = $opt_p; } else { $port = $portdef; } $factor = $ARGV[0] || 1; $DEBUG = 0; $| = 1; print "Chaosreader X11 Replay (experimental)\n\n"; print "Connecting to $host:$port\n"; print "(problems? try running \"xhost +hostname\" first).\n\n"; # --- Open Socket --- # $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port, ); unless ($remote) { die "ERROR31: Can't connect to X11 daemon on $host:$port"; } $remote->autoflush(1); # --- Subroutines --- # # ms - sleeps for specified milliseconds # sub ms { $ms = shift; $ms = $ms / $factor; select(undef, undef, undef, $ms); } # help - print help # sub help { open (MYSELF,"$0") || die "ERROR8: I can't see myself: $!\n"; @Myself = ; close MYSELF; ### Print comment from top of code foreach $line (@Myself) { last if $line !~ /^#/; next if $line =~ m:^#!/usr/bin/perl:; $line =~ s/^#/ /; print $line; } print "\n"; exit(0); } # R - recalculates and prints a resourse setting # The single character subroutine name saves on file space below. # sub R { #$offset = shift; #$new = $res + $offset; my $rid = shift; my $new; # final checks $diff = $rid - $ridbaseold; $diff = -$diff if $diff < 0; if ((($rid < $ridbaseold) && ($rid < 8196)) || ($diff > 8196)) { if ($msb) { return pack('N',$rid); } else { return pack('V',$rid); } } $new = $rid & $ridmaskold; $new = $new | $ridbase; if ($msb) { return pack('N',$new); } else { return pack('V',$new); } } # D - prints the new Drawable, usually the rootid. # sub D { my $rid = shift; # final checks if ($rid >= $ridbaseold) { # return mapped resource id return R($rid); } # return rootid if ($msb) { return pack('N',$rootid); } else { return pack('V',$rootid); } } # C - prints the new Colour map. # sub C { my $rid = shift; # final checks if ($rid >= $ridbaseold) { # return mapped resource id return R($rid); } # return colour map if ($msb) { return pack('N',$colour); } else { return pack('V',$colour); } } # M - Returns a generic mapped id. Can be rootid, colour, or resource. # These are used in Xcodes involving a mask. # sub M { my $rid = shift; # final checks if ($rid >= $ridbaseold) { # return mapped resource id return R($rid); } # return rootid map if ($rid == $rootidold) { if ($msb) { return pack('N',$rootid); } else { return pack('V',$rootid); } } # return colour map if ($rid == $colourold) { if ($msb) { return pack('N',$colour); } else { return pack('V',$colour); } } # return other if ($msb) { return pack('N',$rid); } else { return pack('V',$rid); } } # P - Check depth pixels, print warning if there is a mismatch. # sub P { my $depth = shift; if (! defined $Depth{$depth}) { print "\nWARNING: requested depth $depth may not be ". "supported by the server?\n"; } } # debug - print out a value # sub debug { my $word = shift; my $num = shift; my $pack = pack("N",$num); print "$word: $num ", sprintf("%2.2x%2.2x%2.2x%2.2x\n",unpack("C*",$pack)); } # --- MAIN --- # print "Sending X11 traffic:"; print '.'; print $remote ''; print '.'; print $remote ''; print '.'; print $remote 'l '; $msb = 0; $ridbaseold = 125829120; $ridmaskold = 4194303; $rootidold = 37; $colourold = 33; if ($msb) { $n = "n"; $N = "N"; } else { $n = "v"; $N = "V"; } read($remote,$in,40); # (xConnSetup) ($success,$major,$minor,$length,$release,$ridbase,$ridmask,$mbsize,$vendor, $reqmax,$roots,$formats,$ibo,$bbo,$bslu,$bslp,$keymin,$keymax,$pad) = unpack("a2$n$n$n$N$N$N$N$n${n}CCCCCCCC${N}a*",$in); read($remote,$in,$vendor); print "\nX11 Server Type: $in\n"; read($remote,$in,((4 - ($vendor % 4)) % 4)); foreach $i (1..$formats) { read($remote,$in,8); # (xPixmapFormat) ($depth,$junk) = unpack("Ca*",$in); $Depth{$depth} = 1; next if $depth == 1; print "X11 server supports $depth bit resolution\n"; } read($remote,$in,8); # (xWindowRoot) ($rootid,$colour,$junk) = unpack("$N$N",$in) unless defined $rootid; if ($DEBUG) { debug("Resource ID new: ",$ridbase); debug("Resource ID old: ",$ridbaseold); debug("Root ID new: ",$rootid); debug("Root ID old: ",$rootidold); debug("Colour map new: ",$colour); debug("Colour map old: ",$colourold); } ms(0.0100300312042236); print '.'; print $remote ''; print '.'; print $remote '7',R(125829120),'',D(37),'',M(16777215),'b',R(12),'BIG-REQUESTS',D(37),''; ms(0.00612998008728027); print '.'; print $remote ''; print '.'; print $remote ''; print '.'; print $remote ''; print '.'; print $remote 'b',R(125829129),'XKEYBOARD'; print '.'; print $remote '',R(125829131),'Custom Init'; print '.'; print $remote '',R(125829131),'Custom Data'; ms(0.00679993629455566); print '.'; print $remote '',R(125829136),'SCREEN_RESOURCES'; print '.'; print $remote '',D(37),''; ms(0.00223994255065918); print '.'; print $remote ' ',R(27),'XDCCC_LINEAR_RGB_CORRECTIONU'; print '.'; print $remote ' ',R(25),'XDCCC_LINEAR_RGB_MATRICESONU'; print '.'; print $remote '',D(37),'t'; print '.'; print $remote 'T',C(33),''; ms(0.00281000137329102); print '.'; print $remote '5',R(125829121),'',D(37),'00b',R(6),'RENDER'; ms(0.0171198844909668); print '.'; print $remote '7',R(125829122),'',D(125829121),'Hf',D(125829121),'',R(125829122),'00TS?||>` ` <<xx<x<x<~??<~<xx<8x>` ` >||?<',R(125829122),'5',R(125829123),'',D(37),'007',R(125829124),'',D(125829123),'Hf',D(125829123),'',R(125829124),'00????????????<',R(125829124),'b',R(15),'XFree86-Bigfont'; ms(0.00212001800537109); print '.'; print $remote '-',R(125829125),'5-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*/',R(125829125),''; ms(0.00410008430480957); print '.'; print $remote '- ',R(125829126),'$-*-*-*-R-*-*-*-120-*-*-*-*-ISO8859-1/-',R(125829126),''; ms(0.00477004051208496); print '.'; print $remote ''; ms(0.035099983215332); print '.'; print $remote ''; ms(0.159159898757935); print '.'; print $remote '7',R(125829127),'',D(37),'@',M(12825262),'',M(125829126),'7*',R(125829128),'',D(37),'',M(12825262),'',M(0),'7-',R(125829129),'',D(37),'',M(0),'7',R(125829130),'',D(37),' ',P(24),'',D(125829131),'',D(37),'',R(0),'(',M(12825262),'',M(0),'',M(1),'',M(6422576),'',M(33),'',R(125829131),'\'',R(33554440),'xclock',R(125829131),'%',R(1006632968),'xclock',R(125829131),'"',R(3221422088),'xclock',R(125829131),'$',R(2013265928),'jupiter',R(125829131),'()',R(24608),'',R(125829131),'##',R(4294903584),' \' ',R(125829131),'C',R(125829128),'xclockXClock',R(6684686),'WM_LOCALE_NAME'; ms(0.00261998176574707); print '.'; print $remote ''; print '.'; print $remote '',R(125829131),'m',R(12825096),'C*',R(16),'WM_CLIENT_LEADER'; print '.'; print $remote '',R(125829131),'n!',R(12825120),'  ',D(125829132),'',D(125829131),'',R(0),' (',M(12825262),'',M(0),'',M(163840),'',M(33),' ',R(125829131),'',R(125829131),'',R(16),'WM_DELETE_WINDOW'; print '.'; print $remote '',R(125829132),'WM_PROTOCOLS'; ms(0.0032200813293457); print '.'; print $remote '',R(125829131),'s',R(1397509920),'r',R(125829132),''; ms(0.0263299942016602); print '.'; print $remote 'B{',D(125829132),'',R(125829127),'RRY Y ` a hh oprv|}"!(\'2.54<<DCKKRRYY`ahhoprv|}|}rvophh`aYYRRKKDC<<542.(\'"!|}rvoph h ` a Y YRR K K D C< <542.(\'"!"!(\'2.54<< D C K K E ',D(125829132),'',R(125829130),'WMVMVVWVWWA ',D(125829132),'',R(125829129),'WMVMVVWVWWE ',D(125829132),'',R(125829130),'kDKPKPPYPYkDA ',D(125829132),'',R(125829129),'kDKPKPPYPYkD'; ms(0.694930076599121); print '.'; print $remote ''; ms(0.0464699268341064); print '.'; print $remote ''; ms(0.221920013427734); print '.'; print $remote ''; ms(0.138049840927124); print '.'; print $remote ''; ms(0.935100078582764); print '.'; print $remote ''; ms(0.128900051116943); print '.'; print $remote ''; ms(0.088209867477417); print '.'; print $remote ''; ms(52.1217501163483); print '.'; print $remote ''; print '.'; print $remote '',R(125829127),'Editres',R(720910),'EditresCommand',R(1114127),'EditresProtocol',R(1900560),'EditresClientVal'; ms(0.00217008590698242); print '.'; print $remote '<',R(125829120),'+d'; print '.'; print $remote ''; print '.'; print $remote ''; print " "; close $remote;