ssh/key-type.h: Add parent object to the key structure

* ssh/key-type.h: Add parent object to the key structure.
* ssh/key-type.c (mark_key_smob): Mark parent.
(free_key_smob): Free the key only if it does not have a parent.
(_scm_from_ssh_key): Accept a parent object as the 2nd argument.  All
callers updated.
* ssh/key-func.c (guile_ssh_string_to_public_key)
(guile_ssh_private_key_from_file)
(guile_ssh_public_key_from_private_key)
(guile_ssh_public_key_from_file, guile_ssh_make_keypair): Update.
* ssh/message-func.c (get_auth_req): Accept a SCM message as the 2nd
argument.  All callers updated.
(guile_ssh_message_get_req): Update.

5 files changed, 37 insertions, 12 deletions

diff --git a/ChangeLog b/ChangeLog
index 6f2f5e9..6960925 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2015-02-24  Artyom Poptsov  <poptsov.artyom@gmail.com>
 
+	* ssh/key-type.h: Add parent object to the key structure.
+	* ssh/key-type.c (mark_key_smob): Mark parent.
+	(free_key_smob): Free the key only if it does not have a parent.
+	(_scm_from_ssh_key): Accept a parent object as the 2nd argument.  All
+	callers updated.
+	* ssh/key-func.c (guile_ssh_string_to_public_key)
+	(guile_ssh_private_key_from_file)
+	(guile_ssh_public_key_from_private_key)
+	(guile_ssh_public_key_from_file, guile_ssh_make_keypair): Update.
+	* ssh/message-func.c (get_auth_req): Accept a SCM message as the 2nd
+	argument.  All callers updated.
+	(guile_ssh_message_get_req): Update.
+
 	* ssh/message-func.c (get_auth_req): Use `_scm_from_ssh_key'.
 
 2015-02-22  Artyom Poptsov  <poptsov.artyom@gmail.com>
diff --git a/ssh/key-func.c b/ssh/key-func.c
index d3d038b..6a52de6 100644
--- a/ssh/key-func.c
+++ b/ssh/key-func.c
@@ -81,7 +81,7 @@ Throw `guile-ssh-error' on error.\
 
   scm_dynwind_end ();
 
-  return _scm_from_ssh_key (ssh_public_key);
+  return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -128,7 +128,7 @@ Return a new SSH key of #f on error.\
 
   scm_dynwind_end ();
 
-  return _scm_from_ssh_key (ssh_key);
+  return _scm_from_ssh_key (ssh_key, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -190,7 +190,7 @@ Get public key from a private key KEY.\
   if (res != SSH_OK)
     return SCM_BOOL_F;
 
-  return _scm_from_ssh_key (ssh_public_key);
+  return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -231,7 +231,7 @@ Read public key from a file FILENAME.  Return a SSH key.\
 
   scm_dynwind_end ();
 
-  return _scm_from_ssh_key (ssh_public_key);
+  return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
diff --git a/ssh/key-type.c b/ssh/key-type.c
index 5b002b3..2b95912 100644
--- a/ssh/key-type.c
+++ b/ssh/key-type.c
@@ -48,7 +48,8 @@ struct symbol_mapping key_types[] = {
 SCM
 mark_key_smob (SCM key_smob)
 {
-  return SCM_BOOL_F;
+  struct key_data *kd = _scm_to_key_data (key_smob);
+  return kd->parent;
 }
 
 /* Free the smob. */
@@ -56,7 +57,14 @@ size_t
 free_key_smob (SCM arg1)
 {
   struct key_data *data = _scm_to_key_data (arg1);
-  ssh_key_free (data->ssh_key);
+  if (scm_is_false (data->parent))
+    {
+      /* It's safe to free the key only if it was not derived from some other
+         object and thereby does not share any resources with it.  If the key
+         does have a parent then all the resources will be freed along with
+         it. */
+      ssh_key_free (data->ssh_key);
+    }
   return 0;
 }
 
@@ -136,7 +144,7 @@ Return newly generated private key.  Throw `guile-ssh-error' on error.\
                         scm_list_2 (type, length));
     }
 
-  return _scm_from_ssh_key (key);
+  return _scm_from_ssh_key (key, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -190,13 +198,14 @@ equalp_key (SCM x1, SCM x2)
 /* Helper procedures */
 
 SCM
-_scm_from_ssh_key (ssh_key key)
+_scm_from_ssh_key (ssh_key key, SCM parent)
 {
   struct key_data *key_data;
   SCM key_smob;
   key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data),
                                                 "ssh key");
   key_data->ssh_key = key;
+  key_data->parent = parent;
   SCM_NEWSMOB (key_smob, key_tag, key_data);
   return key_smob;
 }
diff --git a/ssh/key-type.h b/ssh/key-type.h
index 80e8174..d9d8a42 100644
--- a/ssh/key-type.h
+++ b/ssh/key-type.h
@@ -27,6 +27,9 @@ extern scm_t_bits key_tag;
 
 /* Smob data. */
 struct key_data {
+  /* Store the parent object to prevent it from premature GC'ing. */
+  SCM parent;
+
   ssh_key ssh_key;
 };
 
@@ -46,7 +49,7 @@ extern void init_key_type (void);
 
 
 /* Helper procedures */
-extern SCM _scm_from_ssh_key (ssh_key key);
+extern SCM _scm_from_ssh_key (ssh_key key, SCM x);
 extern struct key_data *_scm_to_key_data (SCM x);
 extern inline int _private_key_p (struct key_data *key);
 extern inline int _public_key_p (struct key_data *key);
diff --git a/ssh/message-func.c b/ssh/message-func.c
index 7ec32a6..882b1ac 100644
--- a/ssh/message-func.c
+++ b/ssh/message-func.c
@@ -256,7 +256,7 @@ Get type of the message MSG.\
 
 /* <result> = "#(" <user> <WSP> <password> <WSP> <key> ")" */
 static SCM
-get_auth_req (ssh_message msg)
+get_auth_req (ssh_message msg, SCM scm_msg) /* FIXME: accept only SCM */
 {
   SCM result = scm_c_make_vector (4, SCM_UNDEFINED);
   const char *user     = ssh_message_auth_user (msg);
@@ -276,7 +276,7 @@ get_auth_req (ssh_message msg)
   else
     SCM_SIMPLE_VECTOR_SET (result, 1, SCM_BOOL_F);
 
-  SCM_SIMPLE_VECTOR_SET (result, 2, _scm_from_ssh_key (public_key));
+  SCM_SIMPLE_VECTOR_SET (result, 2, _scm_from_ssh_key (public_key, scm_msg));
 
   pkey_state = _ssh_const_to_scm (pubkey_state_type,
                                   (int) ssh_message_auth_publickey_state (msg));
@@ -398,7 +398,7 @@ Get a request object from the message MSG\
       return get_service_req (ssh_msg);
 
     case SSH_REQUEST_AUTH:
-      return get_auth_req (ssh_msg);
+      return get_auth_req (ssh_msg, msg);
 
     case SSH_REQUEST_CHANNEL_OPEN:
       {