1#!/usr/bin/env perl
2# $XTermId: paste64.pl,v 1.14 2018/11/20 01:05:55 tom Exp $
3# -----------------------------------------------------------------------------
4# this file is part of xterm
5#
6# Copyright 2006-2014,2018 by Thomas E. Dickey
7#
8#                         All Rights Reserved
9#
10# Permission is hereby granted, free of charge, to any person obtaining a
11# copy of this software and associated documentation files (the
12# "Software"), to deal in the Software without restriction, including
13# without limitation the rights to use, copy, modify, merge, publish,
14# distribute, sublicense, and/or sell copies of the Software, and to
15# permit persons to whom the Software is furnished to do so, subject to
16# the following conditions:
17#
18# The above copyright notice and this permission notice shall be included
19# in all copies or substantial portions of the Software.
20#
21# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
22# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
24# IN NO EVENT SHALL THE ABOVE LISTED COPYRIGHT HOLDER(S) BE LIABLE FOR ANY
25# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
26# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28#
29# Except as contained in this notice, the name(s) of the above copyright
30# holders shall not be used in advertising or otherwise to promote the
31# sale, use or other dealings in this Software without prior written
32# authorization.
33# -----------------------------------------------------------------------------
34# Test the paste64 option of xterm.
35
36use strict;
37use warnings;
38
39use Term::ReadKey;
40use IO::Handle;
41use MIME::Base64;
42
43our $target = "";
44
45sub to_hex($) {
46    my $value  = $_[0];
47    my $result = "";
48    my $n;
49
50    for ( $n = 0 ; $n < length($value) ; ++$n ) {
51        $result .= sprintf( "%02X", ord substr( $value, $n, 1 ) );
52    }
53    return $result;
54}
55
56sub show_string($) {
57    my $value = $_[0];
58    my $n;
59
60    my $result = "";
61    for ( $n = 0 ; $n < length($value) ; $n += 1 ) {
62        my $c = ord substr( $value, $n, 1 );
63        if ( $c == ord '\\' ) {
64            $result .= "\\\\";
65        }
66        elsif ( $c == 0x1b ) {
67            $result .= "\\E";
68        }
69        elsif ( $c == 0x7f ) {
70            $result .= "^?";
71        }
72        elsif ( $c == 32 ) {
73            $result .= "\\s";
74        }
75        elsif ( $c < 32 ) {
76            $result .= sprintf( "^%c", $c + 64 );
77        }
78        elsif ( $c > 128 ) {
79            $result .= sprintf( "\\%03o", $c );
80        }
81        else {
82            $result .= chr($c);
83        }
84    }
85
86    printf "%s\r\n", $result;
87}
88
89sub get_reply($) {
90    my $command = $_[0];
91    my $reply   = "";
92
93    printf "send: ";
94    show_string($command);
95
96    print STDOUT $command;
97    autoflush STDOUT 1;
98    while (1) {
99        my $test = ReadKey 1;
100        last if not defined $test;
101
102        #printf "%d:%s\r\n", length($reply), to_hex($test);
103        $reply .= $test;
104    }
105    return $reply;
106}
107
108sub get_paste() {
109    my $reply = get_reply( "\x1b]52;" . $target . ";?\x1b\\" );
110
111    printf "read: ";
112    show_string($reply);
113
114    my $data = $reply;
115    $data =~ s/^\x1b]52;[[:alnum:]]*;//;
116    $data =~ s/\x1b\\$//;
117    printf "chop: ";
118    show_string($data);
119
120    $data = decode_base64($data);
121    printf "data: ";
122    show_string($data);
123}
124
125sub put_paste() {
126    ReadMode 1;
127
128    printf "data: ";
129    my $data = ReadLine 0;
130    chomp $data;
131    ReadMode 5;
132
133    $data = encode_base64($data);
134    chomp $data;
135    printf "data: ";
136    show_string($data);
137
138    my $send = "\x1b]52;" . $target . ";" . $data . "\x1b\\";
139
140    printf "send: ";
141    show_string($send);
142    print STDOUT $send;
143    autoflush STDOUT 1;
144}
145
146sub set_target() {
147    ReadMode 1;
148
149    printf "target: ";
150    $target = ReadLine 0;
151    $target =~ s/[^cps01234567]//g;
152    ReadMode 5;
153    printf "result: %s\r\n", $target;
154}
155
156ReadMode 5, 'STDIN';    # allow single-character inputs
157while (1) {
158    my $cmd;
159
160    printf "\r\nCommand (? for help):";
161    $cmd = ReadKey 0;
162    if ( $cmd eq "?" ) {
163        printf "\r\np=put selection,"
164          . " g=get selection,"
165          . " q=quit,"
166          . " r=reset target,"
167          . " s=set target\r\n";
168    }
169    elsif ( $cmd eq "p" ) {
170        printf " ...put selection\r\n";
171        put_paste();
172    }
173    elsif ( $cmd eq "g" ) {
174        printf " ...get selection\r\n";
175        get_paste();
176    }
177    elsif ( $cmd eq "q" ) {
178        printf " ...quit\r\n";
179        last;
180    }
181    elsif ( $cmd eq "r" ) {
182        printf " ...reset\r\n";
183        $target = "";
184    }
185    elsif ( $cmd eq "s" ) {
186        printf " ...set target\r\n";
187        set_target();
188    }
189}
190ReadMode 0, 'STDIN';    # Reset tty mode before exiting
191