summaryrefslogtreecommitdiff
path: root/.urxvt/extensions/cwd-spawn
blob: fd5e08cee739293fe98a8349eb9c953a8decb22d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
# urxvt prepends "use strict; use utf8;\n", screwing with our line numbers
#line 3

=head1 NAME

cwd-spawn - open a new urxvt within the current working directory.


=head1 INSTALLATION


1) adjust your F<.Xresources>

    URxvt*perl-lib: /home/user/.urxvt
    URxvt*perl-ext: cwd-spawn
    URxvt*keysym.M-o: perl:cwd-spawn

2) copy/symlink this script into F</home/user/.urxvt>

3) adjust your shell config to include these functions
   (known to work with zsh/bash/ksh)

    cwd_to_urxvt() {
        local update="\0033]777;cwd-spawn;path;$PWD\0007"

        case $TERM in
        screen*)
        # pass through to parent terminal emulator
            update="\0033P$update\0033\\";;
        esac

        echo -ne "$update"
    }

    cwd_to_urxvt # execute upon startup to set initial directory

    ssh_connection_to_urxvt() {
        # don't propagate information to urxvt if ssh is used non-interactive
        [ -t 0 ] || [ -t 1 ] || return

        local update="\0033]777;cwd-spawn;ssh;$1\0007"

        case $TERM in
        screen*)
        # pass through to parent terminal emulator
            update="\0033P$update\0033\\";;
        esac

        echo -ne "$update"
    }

4) adjust F<.ssh/config>

    Host *
        PermitLocalCommand yes
        LocalCommand ssh_connection_to_urxvt "%r %h %p"

5) execute cwd_to_urxvt each time you change your directory.

    # zsh supports hooks which execute each time you change your cwd:
    chpwd_functions=(${chpwd_functions} cwd_to_urxvt)

Support for other shells are left as an exercise for the reader ;-)


=head1 BUGS

C<ssh> doesn’t invoke LocalCommand if you connect through “master” mode.
Thus C<cwd-spawn> always copies the connection information into the new terminal.
While this works fine for a single connection, it fails if you nest ssh connections (as a slave through “master” mode).
As a workaround, manually invoke C<ssh_connection_to_urxvt "user host 22">.


=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 Maik Fischer L<maikf+urxvt@qu.cx>

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.


=cut

sub _octal_escape {
    my ($string) = @_;

    my $escape = sub {
        my ($char) = @_;
        ord($char) > 127
            ? $char
            : sprintf("\0%.3o", $char)
    };

    $string =~ s!([^A-Za-z0-9/_-])!$escape->($1)!sge;
    return $string;
}

use Encode;
my $utf8 = Encode::find_encoding('UTF-8');

sub on_osc_seq_perl {
    my ($self, $osc, $resp) = @_;

    return unless $osc =~ s/^cwd-spawn;//;

    # decode raw bytestring into utf8
    local $@;
    $osc = eval { $utf8->decode($osc, Encode::FB_CROAK) };
    if ($@) {
        warn "cwd-spawn: called with garbage: $@";
        return;
    }

    return unless $osc =~ s/^(path|ssh);//;
    my $cmd = $1;

    my $storage = $self->{'cwd-spawn'} ||= {};

    if ($cmd eq 'path') {
        # path sanitizing is context specific, we do that in on_user_command
        $storage->{path} = $osc;

    } else {
        my ($user, $host, $port) = split ' ', $osc;

        # user and port are arguments to parameters, we can pass them as-is
        # host may be used to pass arbitrary parameters to ssh
        return if $host =~ /^-/;

        @{$storage}{qw/user host port/} = ($user, $host, $port);
    }

    $self->_dump if $ENV{DEBUG_URXVT_CWDSPAWN};
    return 1;
}

sub on_user_command {
    my ($self, $cmd) = @_;

    return unless $cmd eq 'cwd-spawn';

    $self->_dump if $ENV{DEBUG_URXVT_CWDSPAWN};

    my $storage = $self->{'cwd-spawn'}
        or return;

    my ($cwd, $user, $host, $port) = @{$storage}{qw/path user host port/};

    my $name = 'URxvt'; # hardcode for now

    my @args;
    if ($host) {
        # escape $path here since it is subject to shell-expansion
        my $path = _octal_escape($cwd);
        @args = (
            '-e',
            'ssh', '-t', '-p', $port, '-l', $user, $host,
                "cd \"$path\"; exec \$SHELL -l"
        )
    } else {
        @args = ('-cd', $cwd);
    }

    warn "cwd-spawn: would start urxvt with: @args"
        if $ENV{DEBUG_URXVT_CWDSPAWN};

    my $term = urxvt::term->new($self->env, $name, @args);

    # ssh doesn't execute LocalCommand if used through ControlMaster
    # see BUGS in POD
    $term->cmd_parse("\e]777;cwd-spawn;ssh;$user $host $port\a") if $host;

    return;
}

sub _dump {
    my $storage = shift->{'cwd-spawn'};
    warn 'cwd-spawn: $storage is empty!' unless $storage;
    warn sprintf('cwd-spawn: ' . ('%s: "%s" ' x keys %$storage), %$storage);
}

# vim: set ts=4 sw=4 sts=4 ft=perl expandtab: