Luke Ross

Scripts

git clone https://lukeross.name/projects/scripts.git/

Small scripts

Commit 9625049d9c836deff8894452b814cb3405e441df

Initial check-in of existing project.

Committed 12 Dec 2014 by Luke Ross

clipshare.pl

@@ -0,0 +1,184 @@
+#!/usr/bin/perl 
+
+# Clipshare - share clipboard between GNOME desktops
+# Copyright (C) 2010 Luke Ross <lr@lukeross.name>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+
+use strict;
+use warnings;
+use utf8;
+
+use Data::Dumper;
+use Glib;
+use Gtk2 '-init';
+use IO::Socket::INET;
+use Storable qw(freeze thaw);
+
+use constant DEBUG => 1;
+
+# We'll manage these clipboards
+my %clipboards = (
+	primary   => Gtk2::Clipboard->get( Gtk2::Gdk->SELECTION_PRIMARY()),
+	clipboard => Gtk2::Clipboard->get( Gtk2::Gdk->SELECTION_CLIPBOARD()),
+);
+
+# Set up the network connections
+my $socket;
+my $listen;
+if (@ARGV) { # Connect to host
+	$socket = IO::Socket::INET->new(PeerAddr => shift(), PeerPort => 6969, Proto => "tcp") or die $!;
+} else {     # Listen for connections
+	my $listen = IO::Socket::INET->new(LocalPort => 6969, Listen => 1, Proto => "tcp") or die $!;
+	$socket = $listen->accept() or die $!;
+}
+
+# Set up a select mask 
+my $rin = "";
+vec($rin,$socket->fileno(),1) = 1;
+
+# Get notification of clipboard changes
+$_->signal_connect(owner_change => \&owner_change) foreach values %clipboards;
+
+# Try to shut down cleanly
+$SIG{INT}     = \&clean_up;
+$SIG{__DIE__} = \&clean_up;
+
+# Set up the message polling handler
+Glib::Timeout->add(100, \&handler);
+
+# And go
+Gtk2->main();
+
+my %owner_is_me; # Whether I own the clipboard and need to ignore changes
+my %targets;     # What formats the remote clipboard supports
+
+# Owder changed
+sub owner_change {
+	my ($clip, $event) = @_;
+	my $name = (grep { $clip == $clipboards{$_} } keys %clipboards)[0]; # Which clipboard changed?
+	print STDERR "owner_change($name): $owner_is_me{$name}\n" if DEBUG;
+	return if $owner_is_me{$name}-- > 0; # Am I ignoring change events?
+	$owner_is_me{$name} = 0 if $owner_is_me{$name} < 0; # Cannot fall below zero
+	print STDERR "Selection of $name changed, sending notification.\n" if DEBUG;
+	my @targets = $clip->wait_for_targets(); # Request the formats this new clipboard supports
+	# Now send the notification and format list to the other side
+	my $payload = pack("cZ*a*", ord("C"), $name, freeze([ map { $_->name } @targets ]));
+	$socket->print(pack("N", length($payload)) . $payload);
+}
+
+sub handler {
+	# Regular poll of the socket for new messages
+	eval {
+		while (select(my $dummy = $rin, undef, undef, 0.1)) {
+			handle_message();
+		}
+	};
+	if ($@) {
+		print "Error: $@, quitting\n";
+		Gtk2->main_quit();
+		clean_up(); # Attempt to close sockets
+		return 0;
+	}
+	return 1;
+}
+
+my $disabled = 0;
+
+sub handle_message {
+	print STDERR "handle_message: @_\n" if DEBUG;
+	return 1 if $disabled and not @_; # Someone's waiting for data, don't slurp it here
+	# Read the packet length
+	$socket->read(my $length, 4) or die $!;
+	$length = unpack("N", $length);
+	# Read the packet ($length characters)
+	my $buffer = "";
+	while(length $buffer < $length) {
+		$socket->read($buffer, $length - length($buffer));
+	}
+	# Unpack it into packet format, the affected clipboard and the payload
+	my ($msg, $clip, $data) = unpack("cZ*a*", $buffer);
+	$msg = chr($msg);
+	if ($msg eq "C") {
+		# Other clipboard changed, grab the local clipboard to match
+		print STDERR "Remote selection $clip changed, updating local clipboard.\n" if DEBUG;
+		print STDERR "formats = ". join(",", @{ thaw($data) }) . "\n" if DEBUG;
+		$targets{$clip} = thaw($data);
+		my $counter = 0;
+		$owner_is_me{$clip}++;
+		if (@{ $targets{$clip} }) {
+			$clipboards{$clip}->set_with_data(\&fetch_remote_data, \&become_inactive, $clip, map {[ $_, [], $counter++ ]} @{ $targets{$clip} });
+		} else {
+			$clipboards{$clip}->clear();
+		}
+	}
+	if ($msg eq "R") {
+		# Other side requested data, return it to them
+		my $target_format = ${ thaw($data) };
+		print STDERR "Remote requested contents of selection $clip, sending in format $target_format.\n" if DEBUG;
+		my $content = @_ ? undef : $clipboards{$clip}->wait_for_contents(Gtk2::Gdk::Atom->new($target_format)); # Stuck in a loop?
+		$content = $content ? {
+			data_type => $content->get_data_type()->name(),
+			data      => $content->get_data(),
+			format    => $content->get_format()
+		} : {}; # Urgh, nothing
+#		print STDERR Dumper $content if DEBUG;
+		# And send
+		my $payload = pack("cZ*a*", ord("D"), $clip, freeze($content));;
+		$socket->print(pack("N", length($payload)) . $payload);
+	}
+	if ($msg eq "D") {
+		# Other side sent data in response to our request
+		print STDERR "Remote returned contents of selection $clip.\n" if DEBUG;
+		return thaw($data);
+	}
+	return 1; # Reschedule the polling
+}
+
+# A local app asked for the data from the remote clipboard
+sub fetch_remote_data {
+	my ($clipobj, $selectiondata, $id, $clip) = @_;
+	print STDERR "Local app requested remote selection, fetching data from remote.\n" if DEBUG;
+	print STDERR "Asking remote for format in id=$id, format=" . $targets{$clip}[$id] . "\n" if DEBUG;
+	# What format do I want it in?
+	my $content = $targets{$clip}[$id];
+	# Request it
+	my $payload = pack("cZ*a*", ord("R"), $clip, freeze(\$content));;
+	$socket->print(pack("N", length($payload)) . $payload);
+	my $return;
+	$disabled = 1; # Disable polling
+	while(not ref $return) { # Keep handling messages til I get a response
+		$return = handle_message(1);
+	}
+	$disabled = 0; # Enable polling again
+	# Return the data to the local app
+	$selectiondata->set(Gtk2::Gdk::Atom->new($return->{data_type}), $return->{format}, $return->{data})
+		if $return->{data_type};
+}
+
+# Another application grabbed the local clopboard. We can ignore this.
+sub become_inactive {
+	my ($clip_obj, $clip_name) = @_;
+	print STDERR "Remote-provided selection replaced by local.\n" if DEBUG;
+}
+
+clean_up(); # Try to clean up
+
+sub clean_up {
+	eval { $socket->close() }; # Close connection to remove host
+	warn $@ if $@;
+	eval { $listen->close() } if $listen; # Clean up listen queue
+	warn $@ if $@;
+}