diff --git a/SLS b/SLS new file mode 100755 index 0000000000000000000000000000000000000000..32a5c8ef041e5d981347d7c5a1c50fe99a26b1ab --- /dev/null +++ b/SLS @@ -0,0 +1,400 @@ +#!/usr/bin/perl +# +# find or create screen session +# +# $Id: SLS,v 1.3 2012/12/14 13:35:38 gonter Exp $ +# + +=pod + +=head1 USAGE + + SLS [-opts] [session] + +=head1 DESCRIPTION + +reattach or create screen which matches given session name + +=head1 SYNOPSIS + + SLS mistkisten + +... reattaches or creates a screen called "mistkisten" + + SLS mistk + +... reattaches the screen called "mistkisten" which was created earlier (or otherwise it creates a screen called "mistk") + +=head1 Options + + -P ... supress process listin + -n ... do not actually perform screen command + -c ... create new session even if one matches + -t ... print entire process tree for a given screen session + +=cut + +use strict; + +use Data::Dumper; +$Data::Dumper::Indent= 1; + +my $print_tree= 0; # 0 print only last command; 1 print all commands in the tree +my $create= 0; +my $doit= 1; +my $list_processes= 1; +my $debug= 0; + +my @PARS= (); +PARS: while (defined (my $arg= shift (@ARGV))) +{ + if ($arg =~ /^-/) + { + if ($arg eq '--') { push (@PARS, @ARGV); last PARS; } + elsif ($arg eq '-c') { $create= 1; } + elsif ($arg eq '-n') { $doit= 0; } + elsif ($arg eq '-P') { $list_processes= 0; } + elsif ($arg eq '-t') { $print_tree= 1; } + elsif ($arg =~ /^-(D+)/) { $debug += length ($1); } + else { &usage (); exit (0); } + } + else + { + push (@PARS, $arg); + } +} + +my $S= &screen_ls (); +## print Dumper ($S); + +my $hostname= &get_hostname (); + +if (@PARS) +{ + my $wanted= shift (@PARS); + + my $dir_changed= 0; + + my @screens= &find_screens_by_label ($S, $wanted); + my $cnt= @screens; + print "create=$create cnt=$cnt screens=", join ('|', @screens), "\n"; + + if ($create || $cnt == 0) + { # no matching screen or force creation + + if (@PARS) + { + my $cdir= shift (@PARS); + &chdir ($cdir); + $dir_changed= 1; + } + + my $cmd_title= "settitle '$hostname:$wanted'"; + print ">>> $cmd_title\n"; + system ($cmd_title) if ($doit); + + my $cmd_screen= "screen -S '$wanted'"; + print ">>> $cmd_screen\n"; + if ($doit) + { + if (!$dir_changed && $wanted =~ /notes/i) { &chdir ("common/Notes"); $dir_changed= 1; } + system ($cmd_screen); + } + } + elsif ($cnt == 1) + { + $wanted= shift (@screens); + + my $cmd_title= "settitle '$hostname:$wanted'"; + print ">>> $cmd_title\n"; + system ($cmd_title) if ($doit); + + my $cmd_screen= "screen -dR '$wanted'"; + print ">>> $cmd_screen\n"; + system ($cmd_screen) if ($doit); + } + else # $cnt > 0: more than one screen found, so give user a chance to be more specific + { + my $PS; + + if ($list_processes) + { + $PS= &ps ('alfxww'); + ## print Dumper ($PS); + } + + &print_screens_by_label2 ($S, $PS, @screens); + } +} +else +{ + my $PS; + if ($list_processes) + { + $PS= &ps ('alfx'); + ## print Dumper ($PS); + } + + &print_screens_by_label ($S, $PS); +} + +exit (0); + +sub chdir +{ + my $dir= shift; + print ">>> chdir '$dir'\n"; + # sleep (5); + + unless (chdir && chdir $dir) + { + print ">>> ATTN: cant change to '$dir' (", $@, ")\n"; + sleep (5); + } +} + +sub usage +{ + exec ("perldoc '$0'"); +} + +sub get_hostname +{ + my $x= $ENV{'BLA'}; + + unless ($x) + { + my ($OS, $y)= split (' ', `uname -a`); + $x= $y; + } + + if ($x) + { + my @x= split (/\./, $x); + my $x= shift (@x); + + # check if $x may need more info + return $x; + } + +} + +sub find_screens_by_label +{ + my $S= shift; + my $wanted= shift; + + print ">> matching /$wanted/i\n"; + my @res= (); + + my $Sl= $S->{'labels'}; + foreach my $l (sort keys %$Sl) + { + print "l=[$l]\n"; + if ($l =~ /$wanted/i) + { + push (@res, $l) + } + } + + @res; +} + +sub print_screens_by_pid +{ + my $S= shift; + my $PS= shift; + + my $Ss= $S->{'screens'}; + foreach my $p (sort {$a <=> $b} keys %$Ss) + { + my $x= $Ss->{$p}; + my ($pid, $status, $label)= map { $x->{$_} } qw(pid status label); + printf ("%7d %s %s\n", $pid, $status, $label); + &print_cmd ($PS, $pid, 0); + } +} + +sub print_screens_by_label +{ + my $S= shift; + my $PS= shift; + + &print_screens_by_label2 ($S, $PS, sort keys %{$S->{'labels'}}); +} + +sub print_screens_by_label2 +{ + my $S= shift; + my $PS= shift; + my @labels= @_; + + printf ("%7s %8s %s\n", 'PID', 'Status', 'Label'); + + my $Sl= $S->{'labels'}; + foreach my $l (@labels) + { + my $x= $Sl->{$l}; + my ($pid, $status, $label)= map { $x->{$_} } qw(pid status label); + printf ("%7d %s %s\n", $pid, $status, $label); + &print_cmd ($PS, $pid, 0); + } +} + +sub print_cmd +{ + my $PS= shift; + my $pid= shift; + my $indent= shift; + + return unless ($PS); + + ## print join (' ', __LINE__, 'pid', $pid, $indent), "\n"; + + my $p= $PS->{'pids'}->{$pid}; + my $c= $PS->{'c'}->{$pid}; + + if (defined ($p) # note: a process with the screen's pid is not in ps list + && ($print_tree || !defined ($c)) + ) + { + $indent += 2; + + my $label_idx= $PS->{'label_idx'}; + my ($pid, $cmd)= map { $p->[$label_idx->{$_}] } qw(PID COMMAND); + printf ("%7d %s %s\n", $pid, ' 'x$indent, $cmd); + ## print ' 'x$indent, join (' ', @$p), "\n"; + } + + if (defined ($c)) + { + ## print ' 'x$indent, join (' ', '->', @$c), "\n"; + foreach my $cpid (@$c) + { + &print_cmd ($PS, $cpid, $indent); + } + } +} + +sub screen_ls +{ + local *S; + open (S, "screen -ls|") or return undef; + + my %screens= (); + my %labels= (); + my $screens= + { + 'screens' => \%screens, + 'labels' => \%labels, + }; + + while (<S>) + { + chop; + print ">>>> $_\n" if ($debug >= 2); + + if (/^There are screens on:/ + || /^\s*$/ + ) + { # NOP; + } + elsif (/^(\d+) Sockets in (.+)/) + { + ($screens->{'cnt'}, $screens->{'socket_dir'})= ($1, $2); + } + elsif (/\s+(\d+)\.(.+)\s*\((Attached|Detached)\)/) + { + my ($pid, $label, $status)= ($1, $2, $3); + my $extra; + if ($label =~ /(.+)\s+\((.+)\)/) + { + ($label, $extra)= ($1, $2); + } + else + { + $label=~ s/\s*$//; + } + ## print ">>>>> pid='$pid' label='$label' status='$status'\n"; + + my $screen= + { + 'pid' => $pid, + 'label' => $label, + 'status' => $status, + }; + $screen->{'extra'}= $extra if ($extra); + + $screens{$pid}= $screen; + $labels{$label}= $screen; + } + } + close (S); + +print Dumper ($screens) if ($debug >= 3); + $screens; +} + +sub ps +{ + my $options= shift || 'alf'; + + local *PS; + open (PS, "ps '$options'|") or die "cant call ps with options='$options'"; + + my %pids= (); + my @labels= (); + my %label_idx= (); + my %c= (); + my $ps= + { + 'labels' => \@labels, + 'label_idx' => \%label_idx, + 'pids' => \%pids, + 'c' => \%c, + }; + my $columns= 999; + + while (<PS>) + { + chop; + ## print ">>> $_\n"; + my @f= split (' ', $_, $columns); + + unless (@labels) + { # first line is the label of the output + @labels= @f; + for (my $i= 0; $i <= $#labels; $i++) + { + $label_idx{$labels[$i]}= $i; + $columns= $i+1; + } + $ps->{'columns'}= $columns; + } + else + { + my ($pid, $ppid)= map { @f[$label_idx{$_}] } qw(PID PPID); + + ## print ">>>>> pid='$pid' ppid='$ppid'\n"; + $pids{$pid}= \@f; + push (@{$c{$ppid}}, $pid); + } + } + close (PS); + + $ps; +} + +__END__ + +=pod + +[2008-06-25 19:30] + +=head1 TODO + +=head2 Config File + +rk_dir= DIR => CD vor screen -S ausfuehren +(what the hell, what does rk_dir mean? chdir?) +