#!/usr/bin/perl
# reattach.pl -- 2007-09-15
# copyright 2007 Thomas Thurman <tthurman@gnome.org>
# distributed under GPL v2 without any warranty express or implied
#
# This program reattaches your screen session, just like "screen -rd" does.
# The difference is that it also modifies the environment of all children
# of the screen so that the variables listed in @FIXABLE_VARIABLES below
# are set to be the same as when you called this program.
#
# I am indebted to Rudd-O of http://rudd-o.com for the idea used in a
# different context: http://mces.blogspot.com/2007/09/linux-shell-puzzle.html
#
# How it works: We can assume that all children of screen are built against
# libc (and in practice, they're almost always the shell) and therefore
# contain the POSIX function setenv(3). gdb is capable of freezing a running
# program ("attaching" to it), calling arbitrary functions within it (such
# as setenv()), and then letting it continue as though nothing happened.
#
# It does require Proc::ProcessTable from CPAN to search the process table;
# it would be possible to do the whole thing by parsing the output of ps,
# so that it required nothing outside basic perl and coreutils, and if anyone
# asks for this I'll have a go.

use strict;
use warnings;
use Proc::ProcessTable;
use vars qw(@ARGV %ENV);

my @FIXABLE_VARIABLES = qw(DISPLAY SSH_AGENT_PID SSH_AUTH_SOCK);
my $gdb = '/usr/bin/gdb';

my $table = new Proc::ProcessTable();

my @screens = grep {
  $_->cmndline =~ '^SCREEN' && $_->uid==$>
} @{$table->table()};

my $chosen_screen;

if (scalar(@ARGV)>0) {
  $chosen_screen = int($ARGV[0]);

  my @match_chosen_screen = grep { $_->pid==$chosen_screen } @screens;

  die "$chosen_screen is not a known screen" unless @match_chosen_screen;

} else {
  # they didn't choose one: if there's only one, use that one
  $chosen_screen = $screens[0] if scalar(@screens)==1;
}

if (scalar(@screens)==0) {
  # No screens attached; just start a new screen
  system('screen');
} elsif ($chosen_screen) {
  # In this case either there's more than one, and they
  # chose one that exists, or there's only one (and maybe
  # they chose it explicitly or maybe they didn't).
  # This is where we actually do something useful.
  environment_hack($chosen_screen);
  system("screen -rd $chosen_screen");
} else {
  # This means there's more than one and they didn't
  # choose one. It'll certainly fail, but screen will do
  # a better job of printing an error than we will.
  system("screen -rd");
}

# Given a process ID, finds all children of that process and
# sets the enviroment variables listed in @FIXABLE_VARIABLES
# to their values in the current process.
sub environment_hack {

  my ($parent) = @_;

  # I would have liked to do this without the temp file and
  # using open GDB, "|-", but gdb doesn't like you writing
  # into it directly, and anyway that's what its -x switch is
  # for.

  my $tmp = "/tmp/gdb$$";
  open GDB, ">$tmp" or die "Can't open $tmp: $!";
  for my $var (@FIXABLE_VARIABLES) {
    my $value = $ENV{$var} || '';
    $var =~ s/"/\\"/g;
    $value =~ s/"/\\"/g;
    print GDB "call setenv(\"$var\", \"$value\", 1)\n";
  }
  print GDB "detach\nquit\n";
  close GDB or die "Can't close $tmp: $!";

  for (@{$table->table()}) {
    next unless $_->uid==$> && $_->ppid==$parent;

    my $command = $_->cmndline;
    $command =~ s/^([^ ]*) (.*)$/$1/;

    system($gdb, $command, $_->pid, '-x', $tmp);
  }

  unlink $tmp;
}