gdbstub initial code, another approach

[Oleg Nesterov <oleg@redhat.com>]

[-- Attachment #1: Type: text/plain, Size: 1207 bytes --]

On 07/26, Oleg Nesterov wrote:
>
> I decided to take a bit different approach, we will see if it
> makes sense in the longer term.

Please see the attached files,

	- ugdb.c

		The kernel module which implements the basic
		user-space API on top of utrace. Of course,
		this API should be discussed.

	- gdbstub

		The simple user-space gdbserver written in
		perl which works with ugdb API.

Limitations:

	- this is just initial code, again.

	- doesn't work in all-stop mode (should be simple to
	  implement).

	- currently it only supports attach, stop, cont, detach
	  and exit.

	- the testing was very limited. I played with it about
	  an hour and didn't find any problems, vut that is all.

However, please note that this time the code is clearly opened
for improvements.

I stronly believe this is the only sane approach. Even for
prototyping. No, _especially_ for prototyping!

Btw, gdb crashes very often right after

	(gdb) set target-async on
	(gdb) set non-stop
	(gdb) file mt-program
	(gdb) target extended-remote :port
	(gdb) attach its_pid

I didn't even try to investigate (this doesn't happen when
it works with the real gdbserver). Just retry, gdb is buggy.

What do you think?

Oleg.

[-- Attachment #2: ugdb.c --]
[-- Type: text/plain, Size: 13085 bytes --]

#include <linux/module.h>
#include <linux/proc_fs.h>
#include <linux/utrace.h>
#include <linux/poll.h>
#include <linux/mm.h>
#include <linux/regset.h>
#include <asm/uaccess.h>

struct ugdb_thread {
	int			t_tid;

	int			t_stop;
	int			t_exit;

	struct pid		*t_spid;
	struct ugdb		*t_ugdb;
	struct utrace_engine	*t_engine;

	struct list_head	t_threads;
	struct list_head	t_stopped;
};

struct ugdb {
	spinlock_t		u_llock;
	struct list_head	u_threads;
	struct list_head	u_stopped;

	wait_queue_head_t	u_wait;
};

// XXX: gdb is single-thread, no locking currently.
#define T printk(KERN_INFO "TRACE: %s:%d\n", __FUNCTION__, __LINE__)

static struct ugdb_thread *ugdb_create_thread(struct ugdb *ugdb, int tid)
{
	struct pid *spid;
	struct ugdb_thread *thread;
	int err;

	err = -ESRCH;
	spid = find_get_pid(tid);
	if (!spid)
		goto err;

	err = -ENOMEM;
	thread = kzalloc(sizeof(*thread), GFP_KERNEL);
	if (!thread)
		goto free_pid;

	thread->t_tid = tid;

	thread->t_spid = spid;
	thread->t_ugdb = ugdb;

	INIT_LIST_HEAD(&thread->t_stopped);
	spin_lock(&ugdb->u_llock);
	list_add_tail(&thread->t_threads, &ugdb->u_threads);
	spin_unlock(&ugdb->u_llock);

	return thread;

free_pid:
	put_pid(spid);
err:
	return ERR_PTR(err);
}

static void ugdb_destroy_thread(struct ugdb_thread *thread)
{
	struct ugdb *ugdb = thread->t_ugdb;

	spin_lock(&ugdb->u_llock);
	list_del(&thread->t_stopped);
	list_del(&thread->t_threads);
	spin_unlock(&ugdb->u_llock);

	put_pid(thread->t_spid);
	kfree(thread);
}

static struct ugdb_thread *ugdb_find_thread(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread;

	spin_lock(&ugdb->u_llock);
	list_for_each_entry(thread, &ugdb->u_threads, t_threads) {
		if (thread->t_tid == tid)
			goto found;
	}
	thread = NULL;
found:
	spin_unlock(&ugdb->u_llock);

	return thread;
}

static int ugdb_set_events(struct ugdb_thread *thread,
				unsigned long events)
{
	return utrace_set_events_pid(thread->t_spid, thread->t_engine,
					events);
}

static int ugdb_control(struct ugdb_thread *thread,
				enum utrace_resume_action action)
{
	return utrace_control_pid(thread->t_spid, thread->t_engine,
					action);
}

static const struct utrace_engine_ops ugdb_utrace_ops;

static struct ugdb_thread *ugdb_attach_thread(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread;
	void *errp;
	int err;

	thread = ugdb_create_thread(ugdb, tid);
	if (IS_ERR(thread)) {
		errp = thread;
		goto err;
	}

	thread->t_engine = utrace_attach_pid(thread->t_spid,
					UTRACE_ATTACH_CREATE,
					&ugdb_utrace_ops,
					thread);
	if (IS_ERR(thread->t_engine)) {
		errp = thread->t_engine;
		goto free_thread;
	}

	err = ugdb_set_events(thread,
			UTRACE_EVENT(QUIESCE) | UTRACE_EVENT(DEATH));
	if (err) {
		errp = ERR_PTR(-ESRCH);
		goto free_engine;
	}

	return thread;

free_engine:
	ugdb_control(thread, UTRACE_DETACH);
	utrace_engine_put(thread->t_engine);
free_thread:
	ugdb_destroy_thread(thread);
err:
	return errp;
}

static void ugdb_detach_thread(struct ugdb_thread *thread)
{
	int ret;

	ret = ugdb_control(thread, UTRACE_DETACH);
	if (ret == -EINPROGRESS)
		utrace_barrier_pid(thread->t_spid, thread->t_engine);
	utrace_engine_put(thread->t_engine);

	ugdb_destroy_thread(thread);
}

static struct ugdb *ugdb_create(void)
{
	struct ugdb *ugdb;
	int err;

	err = -ENODEV;
	// XXX: ugly. proc_reg_open() should take care.
	if (!try_module_get(THIS_MODULE))
		goto out;

	err = -ENOMEM;
	ugdb = kzalloc(sizeof(*ugdb), GFP_KERNEL);
	if (!ugdb)
		goto put_module;

	spin_lock_init(&ugdb->u_llock);
	INIT_LIST_HEAD(&ugdb->u_threads);
	INIT_LIST_HEAD(&ugdb->u_stopped);
	init_waitqueue_head(&ugdb->u_wait);

	return ugdb;

put_module:
	module_put(THIS_MODULE);
out:
	return ERR_PTR(err);
}

static void ugdb_destroy(struct ugdb *ugdb)
{
	struct ugdb_thread *thread;

	while (!list_empty(&ugdb->u_threads)) {
		thread = list_first_entry(&ugdb->u_threads,
				struct ugdb_thread, t_threads);

		ugdb_detach_thread(thread);
	}

	BUG_ON(!list_empty(&ugdb->u_stopped));

	module_put(THIS_MODULE);
	kfree(ugdb);
}

// XXX: Of course, this all is racy --------------------------------------------
enum {
	STOP_RUN,
	STOP_REQ,
	STOP_ACK,
	STOP_FIN,
};

static u32 ugdb_report_quiesce(u32 action, struct utrace_engine *engine,
					unsigned long event)
{
	struct ugdb_thread *thread = engine->data;
	struct ugdb *ugdb = thread->t_ugdb;

	if (event == UTRACE_EVENT(DEATH)) {
		thread->t_exit = current->exit_code | INT_MIN;
		goto ack;
	}

	if (thread->t_stop == STOP_RUN)
		return UTRACE_RESUME;

	if (thread->t_stop != STOP_REQ)
		printk(KERN_INFO "XXX: %d, report_quiesce bad c_stop: %d\n",
				thread->t_tid, thread->t_stop);

ack:
	thread->t_stop = STOP_ACK;

	// SIGKILL can re-add to stopped
	if (list_empty(&thread->t_stopped)) {
		spin_lock(&ugdb->u_llock);
		list_add_tail(&thread->t_stopped, &ugdb->u_stopped);
		spin_unlock(&ugdb->u_llock);
	}
	wake_up_all(&ugdb->u_wait);

	return UTRACE_STOP;
}

static u32 ugdb_report_death(struct utrace_engine *engine,
				bool group_dead, int signal)
{
	return UTRACE_RESUME;
}

static const struct utrace_engine_ops ugdb_utrace_ops = {
	.report_quiesce = ugdb_report_quiesce,
	.report_death	= ugdb_report_death,
};

static int ugdb_stop_thread(struct ugdb_thread *thread)
{
	int err;

	if (thread->t_stop != STOP_RUN)
		return 0;

	thread->t_stop = STOP_REQ;

	// XXX: we don't do UTRACE_STOP! this means we can't
	// stop TASK_STOPEED task. temporarily.

	err = ugdb_control(thread, UTRACE_INTERRUPT);
	if (err && err != -EINPROGRESS)
		return err;
	return 1;
}

static int ugdb_cont_thread(struct ugdb_thread *thread)
{
	struct ugdb *ugdb = thread->t_ugdb;

	if (thread->t_stop == STOP_RUN)
		return 0;

	if (!list_empty(&thread->t_stopped)) {
		spin_lock(&ugdb->u_llock);
		list_del_init(&thread->t_stopped);
		spin_unlock(&ugdb->u_llock);
	}

	thread->t_stop = STOP_RUN;
	ugdb_control(thread, UTRACE_RESUME);
	return 1;
}

static struct task_struct *
ugdb_prepare_examine(struct ugdb_thread *thread, struct utrace_examiner *exam)
{
	struct task_struct *task;

	if (!thread)
		return ERR_PTR(-ESRCH);

	task = pid_task(thread->t_spid, PIDTYPE_PID);
	if (!task)
		return ERR_PTR(-ESRCH);

	for (;;) {
		if (fatal_signal_pending(current))
			return ERR_PTR(-EINTR);

		if (thread->t_stop == STOP_RUN) {
			printk(KERN_INFO "XXX: %d unexpected STOP_RUN\n",
						thread->t_tid);
			return ERR_PTR(-EBUSY);
		}

		if (thread->t_stop != STOP_REQ) {
			int err = utrace_prepare_examine(task,
					thread->t_engine, exam);

			if (err == 0)
				return task;

			if (err == -ESRCH)
				return ERR_PTR(err);
		}

		schedule_timeout_interruptible(1);
	}
}

// -----------------------------------------------------------------------------
#define UGDB_ATTACH	(0x666 + 1)
#define UGDB_DETACH	(0x666 + 2)
#define UGDB_STOP	(0x666 + 3)
#define UGDB_CONT	(0x666 + 4)
#define	UGDB_GETEV	(0x666 + 5)

#define	UGDB_PEEKMEM	(0x666 + 6)
#define	UGDB_POKEMEM	(0x666 + 7)

static int ugdb_attach(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread = ugdb_find_thread(ugdb, tid);

	if (thread)
		return -EALREADY;

	thread = ugdb_attach_thread(ugdb, tid);
	if (IS_ERR(thread))
		return PTR_ERR(thread);

	return 0;
}

static int ugdb_detach(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread = ugdb_find_thread(ugdb, tid);

	if (!thread)
		return -ESRCH;

	ugdb_detach_thread(thread);

	return 0;
}

static int ugdb_stop(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread = ugdb_find_thread(ugdb, tid);

	if (!thread)
		return -ESRCH;

	return ugdb_stop_thread(thread);
}

static int ugdb_cont(struct ugdb *ugdb, int tid)
{
	struct ugdb_thread *thread = ugdb_find_thread(ugdb, tid);

	if (!thread)
		return -ESRCH;

	return ugdb_cont_thread(thread);
}

enum {
	UGDB_EV_STOP,
	UGDB_EV_EXIT,
};

struct ugdb_event {
	int			ev_tid;
	int			ev_type;

	union {
		unsigned	ev_data;
	};
};

static int ugdb_getev(struct ugdb *ugdb, struct ugdb_event __user *uev)
{
	struct ugdb_thread *thread;
	struct ugdb_event ev;

	if (list_empty(&ugdb->u_threads))
		return -ECHILD;

	if (list_empty(&ugdb->u_stopped))
		return -EWOULDBLOCK;

	spin_lock(&ugdb->u_llock);
	thread = list_first_entry(&ugdb->u_stopped,
					struct ugdb_thread, t_stopped);
	list_del_init(&thread->t_stopped);
	spin_unlock(&ugdb->u_llock);

	ev.ev_tid = thread->t_tid;
	ev.ev_type = UGDB_EV_STOP;

	if (thread->t_exit) {
		ev.ev_type = UGDB_EV_EXIT;
		ev.ev_data = thread->t_exit & 0xffff;
	}

	if (copy_to_user(uev, &ev, sizeof(ev)))
		return -EFAULT;

	return 0;
}

struct ugdb_xmem {
	long		tid;

	void __user	*src, *dst;
	unsigned long	len;
};

static typeof(access_process_vm) *u_access_process_vm;

static int ugdb_peekmem(struct ugdb *ugdb, struct ugdb_xmem __user *uxmem)
{
	struct ugdb_xmem xmem;
	struct utrace_examiner exam;
	struct ugdb_thread *thread;
	struct task_struct *task;
	char mbuf[256];
	int size;

	if (copy_from_user(&xmem, uxmem, sizeof(xmem)))
		return -EFAULT;

	thread = ugdb_find_thread(ugdb, xmem.tid);
	task = ugdb_prepare_examine(thread, &exam);
	if (IS_ERR(task))
		return PTR_ERR(task);

	size = 0;
	while (xmem.len) {
		int chunk = min(xmem.len, sizeof (mbuf));

		chunk = u_access_process_vm(task, (unsigned long)xmem.src,
						mbuf, chunk, 0);
		if (chunk <= 0)
			break;

		if (copy_to_user(xmem.dst, mbuf, chunk)) {
			size = -EFAULT;
			break;
		}

		xmem.src += chunk;
		xmem.dst += chunk;
		xmem.len -= chunk;

		size += chunk;
	}

	if (utrace_finish_examine(task, thread->t_engine, &exam))
		size = -ESRCH;

	return size;
}

// XXX: temporarily hack !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#define UGDB_GETREGS	(0x666 + 100)
#define REGSET_GENERAL	0

struct ugdb_getregs {
	long		tid;
	void __user	*addr;
};

static int get_regset(struct task_struct *task, void __user *uaddr)
{
	return copy_regset_to_user(task, task_user_regset_view(current),
					REGSET_GENERAL,
					0, sizeof(struct user_regs_struct),
					uaddr);
}

static int ugdb_getregs(struct ugdb *ugdb, struct ugdb_getregs __user *uregs)
{
	struct ugdb_getregs regs;
	struct utrace_examiner exam;
	struct ugdb_thread *thread;
	struct task_struct *task;
	int err;

	if (WARN_ON(sizeof(struct user_regs_struct) != 216))
		return -EFAULT;

	if (copy_from_user(&regs, uregs, sizeof(regs)))
		return -EFAULT;

	thread = ugdb_find_thread(ugdb, regs.tid);
	task = ugdb_prepare_examine(thread, &exam);
	if (IS_ERR(task))
		return PTR_ERR(task);

	err = get_regset(task, regs.addr);

	if (utrace_finish_examine(task, thread->t_engine, &exam))
		return -ESRCH;

	return err;
}

static long ugdb_f_ioctl(struct file *file, unsigned int cmd, unsigned long arg)
{
	struct ugdb *ugdb = file->private_data;
	int ret = -EINVAL;

	switch (cmd) {
	case UGDB_ATTACH:
		ret = ugdb_attach(ugdb, arg);
		break;

	case UGDB_DETACH:
		ret = ugdb_detach(ugdb, arg);
		break;

	case UGDB_STOP:
		ret = ugdb_stop(ugdb, arg);
		break;

	case UGDB_CONT:
		ret = ugdb_cont(ugdb, arg);
		break;

	case UGDB_GETEV:
		ret = ugdb_getev(ugdb, (void __user*)arg);
		break;

	case UGDB_PEEKMEM:
		ret = ugdb_peekmem(ugdb, (void __user*)arg);
		break;

	case UGDB_GETREGS:
		ret = ugdb_getregs(ugdb, (void __user*)arg);
		break;
	}

	return ret;
}

static unsigned int ugdb_f_poll(struct file *file, poll_table *wait)
{
	struct ugdb *ugdb = file->private_data;
	unsigned int mask;

	poll_wait(file, &ugdb->u_wait, wait);

	mask = 0;
	if (!list_empty(&ugdb->u_stopped))
		mask |= POLLIN;

	return mask;
}

// -----------------------------------------------------------------------------
static int ugdb_f_open(struct inode *inode, struct file *file)
{
	nonseekable_open(inode, file);

	file->private_data = ugdb_create();

	return	IS_ERR(file->private_data) ?
		PTR_ERR(file->private_data) : 0;
}

static int ugdb_f_release(struct inode *inode, struct file *file)
{
	ugdb_destroy(file->private_data);

	return 0;
}

static const struct file_operations ugdb_f_ops = {
	.open			= ugdb_f_open,
	.unlocked_ioctl		= ugdb_f_ioctl,
	.poll			= ugdb_f_poll,
	.release		= ugdb_f_release,
};

#include <linux/kallsyms.h>

struct kallsyms_sym {
	const char	*name;
	unsigned long	addr;
};

static int kallsyms_on_each_symbol_cb(void *data, const char *name,
				struct module *mod, unsigned long addr)
{
	struct kallsyms_sym *sym = data;

	if (strcmp(name, sym->name))
		return 0;

	sym->addr = addr;
	return 1;
}

// XXX: kallsyms_lookup_name() is not exported in 2.6.32
static bool lookup_unexported(void)
{
	struct kallsyms_sym sym;

	sym.name = "access_process_vm";
	if (!kallsyms_on_each_symbol(kallsyms_on_each_symbol_cb, &sym))
		goto err;
	u_access_process_vm = (void*)sym.addr;

	return true;
err:
	printk(KERN_ERR "ugdb: can't lookup %s\n", sym.name);
	return false;
}

#define PROC_NAME	"ugdb"
struct proc_dir_entry *ugdb_pde;

static int __init ugdb_init(void)
{
	if (!lookup_unexported())
		return -ESRCH;

	ugdb_pde = proc_create(PROC_NAME, S_IFREG|S_IRUGO|S_IWUGO,
				NULL, &ugdb_f_ops);
	if (!ugdb_pde)
		return -EBADF;

	return 0;
}

static void __exit ugdb_exit(void)
{
	remove_proc_entry(PROC_NAME, NULL);
}

MODULE_LICENSE("GPL");
module_init(ugdb_init);
module_exit(ugdb_exit);

[-- Attachment #3: gdbstub --]
[-- Type: text/plain, Size: 12781 bytes --]

#!/usr/bin/perl -w

#-----------------------------------------------------------------------------
package utrace;
use strict;
use warnings FATAL => qw(all);
use feature qw(switch);

sub pr { main::pr(@_) }

my $f_ugdb;

use constant {
	# not really needed
	ECHILD		=> 10,
	EAGAIN		=> 11,

	UGDB_ATTACH	=> (0x666 + 1),
	UGDB_DETACH	=> (0x666 + 2),

	UGDB_STOP	=> (0x666 + 3),
	UGDB_CONT	=> (0x666 + 4),

	UGDB_GETEV	=> (0x666 + 5),

	UGDB_PEEKMEM	=> (0x666 + 6),
	UGDB_POKEMEM	=> (0x666 + 7),

# XXX: temporarily hack !!!!!
UGDB_GETREGS => (0x666 + 100),

	UGDB_EV_STOP	=> 0,
	UGDB_EV_EXIT	=> 1,
};

sub create
{
	sysopen $f_ugdb, '/proc/ugdb', 0
		or return;
	return $f_ugdb;
}

sub attach_thread
{
	my ($pid, $tid) = @_;

	defined ioctl $f_ugdb, UGDB_ATTACH, 0+$tid;
}

sub detach_thread
{
	my ($tid) = @_;

	defined ioctl $f_ugdb, UGDB_DETACH, 0+$tid;
}

sub ck_true
{
	defined (my $r = shift) or return;
	$r == 1 or pr "WARN! should be true";
	1;
}

sub stop_thread
{
	my ($tid) = @_;

	ck_true ioctl $f_ugdb, UGDB_STOP, 0+$tid;
}

sub cont_thread
{
	my ($tid) = @_;

	ck_true ioctl $f_ugdb, UGDB_CONT, 0+$tid;
}

sub get_event
{
	defined ioctl $f_ugdb, UGDB_GETEV, my $event = 'x' x 64
		or do {
			# just a sanity check
			return if $! == EAGAIN || $! == ECHILD;
			return (0, 'EV_ERROR', "[errno: $!]");
		};

	my ($tid, $type, $data) = unpack 'i!i!a*', $event;

	my @event;
	given ($type) {
		when (UGDB_EV_STOP)
			{ @event = 'EV_STOP'; }

		when (UGDB_EV_EXIT)
			{ @event = ('EV_EXIT', unpack 'I', $data); }

		@event = ('EV_UNKNOWN', $type);
	}

	$tid, @event;
}

sub read_mem
{
	my ($tid, $addr, $size) = @_;

	my $mbuf = 'x' x $size;
	my $pbuf = unpack 'L!', pack 'P', $mbuf;
	my $xmem = pack 'L!4', 0+$tid, +$addr, 0+$pbuf, $size;

	my $r = ioctl $f_ugdb, UGDB_PEEKMEM, $xmem
		or return;
	substr $mbuf, 0, $r;
}

sub get_regs
{
	my $tid = 0+shift;
	my $regs = 'x' x 216; # struct user_regs_struct

	my $pregs = unpack 'L!', pack 'P', $regs;
	my $xregs = pack 'L!2', 0+$tid, 0+$pregs;
	defined ioctl $f_ugdb, UGDB_GETREGS, $xregs
		or return;
	$regs;
}

#-----------------------------------------------------------------------------
package main;
use strict;
use feature qw(state switch);
use warnings FATAL => qw(all);
no warnings 'portable'; #hex

sub pr { print STDERR "@_\n" }

=pod
	tread:
		T_PID T_TID	pid, tid
		T_XID		pPID.TID

		T_STP		undef, false==pending, or STOP_REPLY

	process:
		P_PID		pid
		P_TID		list of sub-threads

	both:
		S_KEY		= sorting key

=cut
#-----------------------------------------------------------------------------
sub err
{
	pr "ERR!! @_"; return;
}

sub hv($)
{
	sprintf '%02x', 0+shift;
}
sub hs($)
{
	unpack 'H*', shift // return undef;
}

sub shex($)
{
	my $h = shift; ($h =~ s/^-//) ? -hex $h : +hex $h;
}

sub __s_key
{
	sort { $a->{S_KEY} <=> $b->{S_KEY} } values %{+shift}
}

my ($O_NOACK, $O_NOSTOP);
my ($S_KEY, $P_NUM, %P_ALL, %T_ALL) = (0, 0);
my ($G_CURR, $C_CURR);

sub select_threads
{
	my ($pid, $tid) = @_;

	$pid < 0 || $tid < 0 and
		return err "unexpected multi-THREAD-ID"
		unless wantarray;

	return unless %T_ALL;

	if ($tid > 0) {
		my $t = $T_ALL{$tid} || return;
		$t->{T_PID} == $pid || return if $pid > 0;
		return $t;
	}

	my @p;
	if ($pid > 0) {
		@p = $P_ALL{$pid} || return;
	} else {
		@p = __s_key \%P_ALL;
		splice @p, 1 unless $pid;
	}

	my @t = map {
		my @t = __s_key $_->{P_TID} or die;
		splice @t, 1 unless $tid;
		@t;
	} @p;

	die unless @t;

	wantarray ? @t : $t[0];
}

sub select_one_thread
{
	scalar select_threads @_;
}

sub attach_thread
{
	my ($p, $tid) = @_;
	my $pid = $p->{P_PID};

	die if $T_ALL{$tid} || $p->{P_TID}{$tid};

	utrace::attach_thread $pid, $tid
		or return err "attach $tid failed: $!";

	$T_ALL{$tid} = $p->{P_TID}{$tid} = {
		S_KEY => ++$S_KEY,

		T_PID => $pid,
		T_TID => $tid,
		T_XID => sprintf('p%x.%x', $pid, $tid),

		T_STP => undef,
	};
}

sub detach_thread
{
	my ($p, $t) = @_;
	my $tid = $t->{T_TID};

	utrace::detach_thread $tid, $t->{T_STP}
		or err "detach $tid: $!";

	$_ && $_ == $t and undef $_ for $G_CURR, $C_CURR;

	$t == delete $T_ALL{$tid} or die;
	$t == delete $p->{P_TID}{$tid} or die;

	return $t;
}

sub detach_process
{
	my $p = shift;

	detach_thread $p, $_ for values %{$p->{P_TID}};
	$p == delete $P_ALL{$p->{P_PID}} or die;

	if (--$P_NUM <= 0) {
		die if $P_NUM;
		die if %T_ALL;
		die if %P_ALL;
		die if $G_CURR || $C_CURR;
	}

	die if keys %{$p->{P_TID}};
	return $p;
}

sub proc_list_pid
{
	my $pid = shift;
	my @tid = map /(\d+)\z/, glob "/proc/$pid/task/*";
	# do not return an empty list!
	@tid ? @tid : $pid;
}

sub c_attach
{
	# XXX: todo !!!!!!
	$O_NOSTOP || return err "Sorry, all-stop mode is not implemented yet.";

	my $pid = shex shift;

	$P_ALL{$pid} and
		return err "$pid already attached";

	$P_NUM++;
	$P_ALL{$pid} = my $p = {
		S_KEY => ++$S_KEY,

		P_PID => $pid,
	};

	for my $tid (proc_list_pid $pid) {
		attach_thread $p, $tid or do {
			detach_process $p;
			return;
		};
	}

	# seems not strictly necessary ?
	$G_CURR = $p->{P_TID}{$pid} if !$O_NOSTOP;

	$p;
}

sub c_detach
{
	detach_process $P_ALL{shex shift} || return;
}

# for ptrace plugin
sub utrace::stop_pending
{
	my $t = $T_ALL{+shift} || return;
	defined $t->{T_STP} && !$t->{T_STP};
}

sub stop_one_thread
{
	my $t = shift;

	unless (defined $t->{T_STP}) {
		utrace::stop_thread $t->{T_TID}
			or return err "stop $t->{T_TID}: $!";

		$t->{T_STP} = '';
	}

	$t;
}

sub stop_threads
{
	stop_one_thread $_ for @{+shift};
}

sub cont_one_thread
{
	my $t = shift;

	if (defined $t->{T_STP}) {
		utrace::cont_thread $t->{T_TID}, $t->{T_STP}
			or return err "cont $t->{T_TID}: $!";

		undef $t->{T_STP};
	}

	$t;
}

sub cont_threads
{
	cont_one_thread $_ for @{+shift};
}

sub c_thread_info
{
	'm' . join ',', map $_->{T_XID}, select_threads -1, -1;
}

sub c_setcurr
{
	my ($w, $pid, $tid) = @_;

	my $t = select_one_thread shex $pid, shex $tid
		or return;

	$w eq 'g' ? ($G_CURR = $t) :
	$w eq 'c' ? ($C_CURR = $t) :
	err "H$w not implemented";
}

sub c_ck_alive
{
	my ($pid, $tid) = @_;

	my $t = select_one_thread shex $pid, shex $tid
		or return;

	$t;
}

# include/gdb/signals.h:target_signal (incomplete)
my @to_gdb_sigmap = (
	(7, 10),  (10,30),  (12,31),  (17,20),  (18,19),  (19,17),
	(20,18),  (23,16),  (29,23),  (30,32),  (31,12));

sub sig_to_gdb($)
{
	my $sig = shift;
	state $map = {@to_gdb_sigmap};
	$map->{$sig} || $sig;
}

sub sig_from_gdb($)
{
	my $sig = shift;
	state $map = {reverse @to_gdb_sigmap};
	$map->{$sig} || $sig;
}

# gdb-7.1/gdb/gdbserver/linux-x86-low.c
my @x86_64_regmap = (
	10,  5, 11, 12, 13, 14,  4, 19,  9,  8,  7,  6,  3,  2,  1,  0,
	16, 18, 17, 20, 23, 24, 25, 26, -1, -1, -1, -1, -1, -1, -1, -1,
	-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
	-1, -1, -1, -1, -1, -1, -1, -1, -1, 15);

sub c_get_regs
{
	my $regs = utrace::get_regs $G_CURR->{T_TID}
		or return undef;

	my @regs = unpack 'L!*', $regs;

	hs pack 'L!*', map {
		$_ >= 0
			? $regs[$_] // die
			: 0;
	} @x86_64_regmap;
}

sub c_read_mem
{
	my ($addr, $size) = @_;

	hs utrace::read_mem $G_CURR->{T_TID},
			hex $addr, hex $size;
}

my $RE_HEX = qr/([a-f\d]+)/;
my $RE_PID = qr/(-?[a-f\d]+)/;
my $RE_XID = qr/p$RE_PID.$RE_PID/;

sub c_vcont
{
	my %seen;

	for (split ';', shift) {
		my ($cmd, $pid, $tid) = /^ ([^:]+) (?: : $RE_XID )? \z/x
			or return err "vCont: can't parse '$_'";

		($pid, $tid) = defined $pid
			? (shex $pid, shex $tid)
			: (-1, -1);

		my $handler;
		given ($cmd) {
			when ('t')
				{ $handler = \&stop_threads }
			when ('c')
				{ $handler = \&cont_threads }

			return err "vCont;$cmd is not implemented!";
		}

		my @threads = grep !$seen{$_->{T_XID}}++,
				select_threads $pid, $tid
			or err "vCont: no threads in '$_'";

		$handler->(\@threads);
	}

	scalar %seen;
}

# XXX: this all is wrong. blame gdb!!!
sub hack_exit
{
	my ($tid, $code) = @_;
	my $t = $T_ALL{$tid} || die;
	my $p = $P_ALL{$t->{T_PID}} or die;

	detach_thread $p, $t;

	return unless $p->{P_PID} == $tid;

	# main thread dies. report the group exit.
	detach_process $p;

	my $stp;
	if ($code & 0xff) {
		$stp = 'X' . hv sig_to_gdb($code & 0xff);
	} else {
		$stp = 'W' . hv(($code >> 8) & 0xff);
	}

	my $xid = hv $p->{P_PID};
	$stp .= ";process:$xid";

	return $stp;
}

my ($V_CUR, %V_STP, @V_STP);

sub handle_event
{
	my ($tid, $ev_name, @ev_data) = @_;

	my ($t, $stp);

	given ($ev_name) {
		when ('EV_STOP')
			{ $stp = 'T00' }
		when ('EV_SIGNAL')
			{ $stp = 'T' . hv sig_to_gdb $ev_data[0] }

		when ('EV_EXIT') {
			# XXX!!!!!! I do not know what to do with
			# the current limitations. The dirty hack
			# for now

			$stp = hack_exit $tid, $ev_data[0] or return;
			push @V_STP, +{ T_STP => $stp, };
			return;
		}

		die "unimplemented event: tid=$tid $ev_name, @ev_data";
	}

	$t = $T_ALL{$tid} || die;

	$t->{T_STP} = $stp . "thread:$t->{T_XID};";

	push @V_STP, $t unless $V_STP{$t->{T_XID}}++;
}

sub get_notification
{
	@V_STP && !$V_CUR && $V_STP[0]{T_STP};
}

sub c_vstopped
{
	@V_STP || err 'unexpected vStopped';

	++$V_CUR < @V_STP and
		return $V_STP[$V_CUR]{T_STP} || die;

	($V_CUR, %V_STP, @V_STP) = ();
	return 'OK';
}

sub handle_cmd
{
	given ($_) {
		when (/^qSupported (.*multiprocess\+)?/x) {
			$1 || die "ERR!! need multiprocess\n";
			@_ = join ';', qw{
				PacketSize=400 QStartNoAckMode+
				QNonStop+ multiprocess+};
		}

		when ('vCont?')
			{ @_ = 'vCont;t;c;C;s;S' }

		@_ = 'OK';

		when ('QStartNoAckMode')
			{ $O_NOACK = 1 }
		when (/^QNonStop:([01])/)
			{ $O_NOSTOP = !!$1 }
		when ([qw'!']) {}


		@_ = undef;

		when (/^vAttach; $RE_PID \z/x)
			{ @_ = $O_NOSTOP ? 'OK':'S05' if c_attach $1 }
		when (/^D; $RE_PID \z/x)
			{ @_ = 'OK' if c_detach $1 }

		when (/^H (.) $RE_XID \z/x)
			{ @_ = 'OK' if c_setcurr $1, $2, $3 }
		when ('qC')
			{ @_ = 'QC' . $G_CURR->{T_XID} if $G_CURR }
		when (/^T $RE_XID \z/x)
			{ @_ = 'OK' if c_ck_alive $1, $2 }

		when ('qfThreadInfo')
			{ @_ = c_thread_info if %T_ALL }
		when ('qsThreadInfo')
			{ @_ = 'l' }

		when (/^vCont;(.*)/)
			{ @_ = 'OK' if c_vcont $1 }
		when ('vStopped')
			{ @_ = c_vstopped }

		when ('g')
			{ @_ = c_get_regs if $G_CURR }
		when (/^m $RE_HEX , $RE_HEX \z/x)
			{ @_ = c_read_mem $1, $2 if $G_CURR }

		when (/^[GM]/)
			{ } # uninplemented ...

		@_ = '';

		when ('qTStatus')
			{ @_ = 'T0' }
		when ('?')
			{ @_ = $O_NOSTOP ? 'OK' : 'W00' }
	}

	return @_;
}

#-----------------------------------------------------------------------------
my ($F_UGDB, $F_CONN, $F_OCMD);

use constant {
	# ARCH DEPENDANT
	FIONBIO		=> 0x5421,
	EAGAIN		=> 11,
};

sub echo
{
	my $str = "@_";
	substr($str, 62) = '...' if length $str > 64;
	pr $str;
};

sub __put
{
	# XXX: doesn't support NONBLOCK or short writes
	my $w = syswrite $F_OCMD, my $pkt = join '', @_;
	($w ||= 0) == length $pkt or
		die 'ERR!! conn put(', length $pkt, ')',
			"failed: $w $!\n";
}

sub __put_pkt
{
	my $sym = shift;
	my $pkt = join '', @_;
	my $csm = 0; $csm += ord $1 while $pkt =~ /(.)/sg;
	__put $sym, $pkt, '#', hv $csm % 256;
	echo '<=', $pkt;
}

sub put_p
{
	__put_pkt '$', @_;
}
sub put_n
{
	__put_pkt '%', @_;
}

sub get_p
{
	state $buf = '';

	for (;;) {
		$buf =~ s/^\+*//;
		$buf =~ s/^\$ ([^#]*) \#..//x and $_ = $1, last;

		if ($buf =~ s/^([^\$]+)//s) {
			err "bad cmd or nack: $1";
		} elsif (!sysread $F_CONN, $buf, 4096, length $buf) {
			return if $! == EAGAIN;
			pr 'conn closed:', $! || 'EOF';
			exit;
		}
	}

	__put '+' unless $O_NOACK;
	echo '=>', $_;
	1;
}

sub process_cmds
{
	while (get_p) {
		my ($r, @r) = handle_cmd or next;
		put_p $r // 'E01', @r;
	}
}

sub process_ugdb
{
	while (my @ev = utrace::get_event)
	{
		handle_event @ev;
	}

	my $n = get_notification;
	put_n 'Stop:' . $n if $n;
}

sub main_loop
{
	($F_CONN, $F_OCMD) = @_;

	$F_UGDB = utrace::create
		or die "ERR!! can't create utrace fd: $!\n";

	ioctl $F_CONN, FIONBIO, pack 'i!', 1 or die $!;
	ioctl $F_UGDB, FIONBIO, pack 'i!', 1 or die $!;

	for (my $rfd = '';;) {
		vec($rfd, fileno $F_CONN, 1) = 1;
		vec($rfd, fileno $F_UGDB, 1) = 1;

		0 < select $rfd, undef, undef, undef
			or next; # EINTR

		process_cmds if vec $rfd, fileno $F_CONN, 1;
		process_ugdb if vec $rfd, fileno $F_UGDB, 1;
	}
}

sub wait_for_connect
{
	my $port = 0+shift;

	socket my $sk, 2,1,0
		or return err "sock create: $!";
	defined setsockopt $sk, 1,2,1
		or return err "sock reuseaddr: $!";
	bind $sk, pack 'Sna12', 2, $port, ''
		or return err "sock bind $port port: $!";
	listen $sk, 2
		or return err "sock listen: $!";

	pr "wait for connection on $port port ...";
	accept my $conn, $sk
		or return err "sock accept: $!";

	return $conn;
}

sub main
{
	my $port = 2000;

	if (@_) {
		$port = shift;

		die "Usage: $0 [port]\n"
			if @_ || $port =~ /\D/;
	}

	my $conn = wait_for_connect $port or exit;
	main_loop $conn, $conn;
}

main @ARGV;