-
Notifications
You must be signed in to change notification settings - Fork 4
/
jdwp.el
executable file
·1701 lines (1547 loc) · 64.9 KB
/
jdwp.el
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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; jdwp.el --- library to communicate using Java(tm) Debug Wire Protocol
;; Copyright (C) 2008 Phuah Yee Keat
;; Author: Phuah Yee Keat <[email protected]>
;; Maintainer: Troy Daniels <[email protected]>
;; Created: 20 May 2008
;; Keywords: lisp tools
;; This file is NOT part of GNU Emacs.
;; 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 3 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, see `http://www.gnu.org/licenses/'.
;;; Commentary:
;; This module try to implement everything documented here:
;; http://java.sun.com/j2se/1.4.2/docs/guide/jpda/jdwp/jdwp-protocol.html
;; http://java.sun.com/j2se/1.4.2/docs/guide/jpda/jdwp-spec.html
;; This module requires elog.el
;;; Code:
(require 'bindat)
(require 'elog)
(require 'jdibug-util)
(eval-when-compile
(load "cl-seq")
(load "cl-extra"))
(defcustom jdwp-timeout 3
"Number of seconds to timeout before replies arrive from the debuggee."
:group 'jdibug
:type 'integer)
(defcustom jdwp-block-seconds 0.1
"The number of seconds we block before checking for user activity"
:group 'jdibug
:type 'float)
(elog-make-logger jdwp)
(elog-make-logger jdwp-traffic)
(defvar jdwp-ignore-error nil
"If an error response to `jdwp-send-command' is contained in this list, nil is returned rather than throwing an error")
(defvar jdwp-uninterruptibly-running-p nil
"Flag to indicate if an uninterruptible function is already running")
(defvar jdwp-uninterruptibly-waiting nil
"List of objects to process uninterruptibly.")
(defstruct jdwp
;; the elisp process that connects to the debuggee
process
;; the state of our process
handshaked-p
;; the last used command id that we sent to the server
(current-id -1)
;; place where you can store anything
plist
current-reply
;; VM specific sizes that need to be set before any communication happens
(field-id-size 4)
(method-id-size 4)
(object-id-size 4)
(reference-type-id-size 4)
(frame-id-size 4)
server
port)
(defstruct jdwp-packet
length
id
flags
data)
(defstruct (jdwp-packet-reply (:include jdwp-packet))
error)
(defstruct (jdwp-packet-command (:include jdwp-packet))
command-set
command)
;;; Constants:
(defconst jdwp-event-single-step 1)
(defconst jdwp-event-breakpoint 2)
(defconst jdwp-event-frame-pop 3)
(defconst jdwp-event-exception 4)
(defconst jdwp-event-user-defined 5)
(defconst jdwp-event-thread-start 6)
(defconst jdwp-event-thread-end 7)
(defconst jdwp-event-class-prepare 8)
(defconst jdwp-event-class-unload 9)
(defconst jdwp-event-class-load 10)
(defconst jdwp-event-field-access 20)
(defconst jdwp-event-field-modification 21)
(defconst jdwp-event-exception-catch 30)
(defconst jdwp-event-method-entry 40)
(defconst jdwp-event-method-exit 41)
(defconst jdwp-event-vm-init 90)
(defconst jdwp-event-vm-start 90)
(defconst jdwp-event-vm-death 99)
(defconst jdwp-step-depth-into 0)
(defconst jdwp-step-depth-over 1)
(defconst jdwp-step-depth-out 2)
(defconst jdwp-tag-array 91)
(defconst jdwp-tag-byte 66)
(defconst jdwp-tag-char 67)
(defconst jdwp-tag-object 76)
(defconst jdwp-tag-float 70)
(defconst jdwp-tag-double 68)
(defconst jdwp-tag-int 73)
(defconst jdwp-tag-long 74)
(defconst jdwp-tag-short 83)
(defconst jdwp-tag-void 86)
(defconst jdwp-tag-boolean 90)
(defconst jdwp-tag-class-object 99)
(defconst jdwp-tag-string 115)
(defconst jdwp-tag-thread 116)
(defconst jdwp-tag-thread-group 103)
(defconst jdwp-tag-class-loader 108)
(defconst jdwp-tag-constants
(let (values)
(mapatoms
(lambda (atom)
(let ((name (symbol-name atom)))
(when (and (string-match "^jdwp-tag-\\(.+\\)$" name)
(not (string-equal name "jdwp-tag-constants")))
(push (cons (symbol-value atom)
(match-string 1 name))
values)))))
values)
"Map from jdwp type constants to printable names")
(defconst jdwp-type-tag-class 1)
(defconst jdwp-type-tag-interface 2)
(defconst jdwp-type-tag-array 3)
(defconst jdwp-suspend-policy-none 0)
(defconst jdwp-suspend-policy-event-thread 1)
(defconst jdwp-suspend-policy-all 2)
(defconst jdwp-invoke-single-threaded 1)
(defconst jdwp-invoke-nonvirtual 2)
(defconst jdwp-thread-status-zombie 0)
(defconst jdwp-thread-status-running 1)
(defconst jdwp-thread-status-sleeping 2)
(defconst jdwp-thread-status-monitor 3)
(defconst jdwp-thread-status-wait 4)
(defconst jdwp-thread-status-constants
`( (,jdwp-thread-status-zombie . "Zombie")
(,jdwp-thread-status-running . "Running")
(,jdwp-thread-status-sleeping . "Sleeping")
(,jdwp-thread-status-monitor . "Monitor")
(,jdwp-thread-status-wait . "Waiting")))
(defconst jdwp-suspend-status-suspended 1)
(defconst jdwp-mod-kind-case-count 1)
(defconst jdwp-mod-kind-case-conditional 2)
(defconst jdwp-mod-kind-case-thread-only 3)
(defconst jdwp-mod-kind-class-only 4)
(defconst jdwp-mod-kind-class-match 5)
(defconst jdwp-mod-kind-class-exclude 6)
(defconst jdwp-mod-kind-location-only 7)
(defconst jdwp-mod-kind-exception-only 8)
(defconst jdwp-mod-kind-field-only 9)
(defconst jdwp-mod-kind-case-step 10)
(defconst jdwp-mod-kind-instance-only 11)
(defconst jdwp-error-constants
`((0 none "No error has occured.")
(10 invalid-thread "Passed thread is null, is not a valid thread or has exited.")
(11 invalid-thread-group "Thread group invalid.")
(12 invalid-priority "Invalid priority.")
(13 thread-not-suspended "If the specified thread as not been suspended by an event.")
(14 thread-suspended "Thread already suspended.")
(20 invalid-object "If this reference type has been unloaded and garbage collected.")
(21 invalid-class "Invalid class.")
(22 invalid-location "Invalid location.")
(23 invalid-methodid "Invalid method.")
(24 invalid-location "Invalid location.")
(25 invalid-fieldid "Invalid field.")
(30 invalid-frameid "Invalid jframeID.")
(31 no-more-frames "There are no more Java or JNI frames on the call stack.")
(32 opaque-frame "Information about the frame is not available.")
(33 not-current-frame "Operation can only be performed on current frame.")
(34 type-mismatch "The variable is not appropriate type for the function used.")
(35 invalid-slot "Invalid slot")
(40 duplicate "Item already set.")
(41 not-found "Desired element not found.")
(50 invalid-monitor "Invalid monitor.")
(51 not-monitor-owner "This thread doesn't own the monitor.")
(52 interrupt "The call has been interrupted before completion.")
(60 invalid-class-format "The virtual machine attempted to read a class file and determined that the file is malformed or otherwise cannot be interpreted as a class file")
(61 circular-class-definition "A circularity has been detected while initializing a class.")
(62 fails_verification "The verifier detected that a class file, though well formed, contained some sort of internal inconsistency or security problem.")
(63 add-method-not-implemented "Adding methods has not been implemented.")
(64 schema-change-not-implemented "Schema change has not been implemented.")
(65 invalid-typestate "The state of the thread has been modified, and is not inconsistent.")
(66 hierarchy-change-not-implemented "A direct superclass is different for the new class version, or the set of directly implemented interfaces is different and canUnrestrictedlyRedefineClasses is false.")
(67 delete-method-not-implemented "The new class version does not declare a method declared in the old class version and canUnrestrictedlyRedefineClasses is false.")
(68 unsupported-version "A class file has a version number not supported by this VM.")
(69 names-dont-match "The class name defined in the new class file is different from the name in the old class object.")
(70 class-modifiers-change-not-implemented "The new class version has different modifiers and canUnrestrictedlyRedefineClasses is false.")
(71 method-modifiers-change-not-implemented "A method in the new class version has different modifiers than its counterpart in the old class version and canUnrestrictedlyRedefineClasses is false.")
(99 not-implemented "The functionality is not implemented in this virtual machine.")
(100 null-pointer "Invalid pointer.")
(101 absent-information "Desired information is not available.")
(102 invalid-event-type "The specified event type id is not recognized.")
(103 illegal-argument "Illegal argument.")
(110 out-of-memory "The function needed to allocate memory and no more memory was available for allocation.")
(111 access-denied "Debugging has not been enabled in this virtual machine. JVMDI cannot be used.")
(112 vm-dead "The virtual machine is not running.")
(113 internal "An unexpected internal error has occurred.")
(500 invalid-tag "object type id or class tag.")
(502 already-invoking "Previous invoke not complete.")
(503 invalid-index "Index is invalid.")
(504 invalid-length "The length is invalid.")
(506 invalid-string "The string is invalid.")
(507 invalid-class-loader "The class loader is invalid.")
(508 invalid-array "The array is invalid.")
(509 transport-load "Unable to load the transport.")
(510 transport-init "Unable to initialize the transport.")
(511 native-method "")
(512 invalid-count "The count is invalid.")))
;; generate variables for each of the error codes for easier access
(dolist (element jdwp-error-constants)
(let ((code (car element))
(sym (intern (format "jdwp-error-%s" (nth 1 element)))))
(set sym code)))
;;; The bindat specifications:
(defconst jdwp-packet-spec
'((:length u32)
(:id u32)
(:flags u8)))
(defconst jdwp-command-spec
'((:length u32)
(:id u32)
(:flags u8)
(:command-set u8)
(:command u8)))
(defconst jdwp-reply-spec
'((:length u32)
(:id u32)
(:flags u8)
(:error u16)))
(defconst jdwp-string-spec
'((:length u32)
(:string vec (:length))))
(defconst jdwp-location-spec
'((:type u8)
(:class-id vec (eval jdwp-reference-type-id-size))
(:method-id vec (eval jdwp-method-id-size))
(:index vec 8)))
(defconst jdwp-tagged-object-spec
'((:type u8)
(:object vec (eval jdwp-object-id-size))))
(defconst jdwp-event-spec
`((:suspend-policy u8)
(:events u32)
(:event repeat (:events)
(:event-kind u8)
(:u union (:event-kind)
(,jdwp-event-vm-start (:request-id u32)
(:thread vec (eval jdwp-object-id-size)))
(,jdwp-event-single-step (:request-id u32)
(:thread vec (eval jdwp-object-id-size))
(:location struct jdwp-location-spec))
(,jdwp-event-thread-start (:request-id u32)
(:thread vec (eval jdwp-object-id-size)))
(,jdwp-event-breakpoint (:request-id u32)
(:thread vec (eval jdwp-object-id-size))
(:location struct jdwp-location-spec))
(,jdwp-event-exception (:request-id u32)
(:thread vec (eval jdwp-object-id-size))
(:location struct jdwp-location-spec)
(:exception struct jdwp-tagged-object-spec)
(:catch-location struct jdwp-location-spec))
(,jdwp-event-class-prepare (:request-id u32)
(:thread vec (eval jdwp-object-id-size))
(:ref-type-tag u8)
(:type-id vec (eval jdwp-reference-type-id-size))
(:signature struct jdwp-string-spec)
(:status u32))
(,jdwp-event-class-unload (:request-id u32)
(:signature struct jdwp-string-spec))
(,jdwp-event-vm-death (:request-id u32))))))
(defconst jdwp-value-spec
`((:type u8)
(:u union (:type)
(,jdwp-tag-array (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-byte (:value u8))
(,jdwp-tag-char (:value u16))
(,jdwp-tag-object (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-float (:value vec 4))
(,jdwp-tag-double (:value vec 8))
(,jdwp-tag-int (:value vec 4))
(,jdwp-tag-long (:value vec 8))
(,jdwp-tag-short (:value u16))
(,jdwp-tag-void)
(,jdwp-tag-boolean (:value u8))
(,jdwp-tag-string (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-thread (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-thread-group (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-class-loader (:value vec (eval jdwp-object-id-size)))
(,jdwp-tag-class-object (:value vec (eval jdwp-object-id-size))))))
(defconst jdwp-arrayregion-header-spec
'((:type u8)
(:length u32)))
;; declare the dynamic variables for our unpacker
(defmacro jdwp-with-size (jdwp &rest body)
(declare (indent defun))
`(let ((jdwp-field-id-size (jdwp-field-id-size ,jdwp))
(jdwp-method-id-size (jdwp-method-id-size ,jdwp))
(jdwp-object-id-size (jdwp-object-id-size ,jdwp))
(jdwp-reference-type-id-size (jdwp-reference-type-id-size ,jdwp))
(jdwp-frame-id-size (jdwp-frame-id-size ,jdwp)))
,@body))
(defun jdwp-unpack-arrayregion (jdwp packet)
(jdwp-trace "jdwp-unpack-arrayregion:%s" (jdwp-string-to-hex packet))
(jdwp-with-size
jdwp
(let* ((header (bindat-unpack jdwp-arrayregion-header-spec packet))
(type (bindat-get-field header :type))
(length (bindat-get-field header :length))
repeater spec)
(setq repeater
(case type
; object
(76 '(:value struct jdwp-value-spec))
; array
(91 '(:value struct jdwp-value-spec))
; byte
(66 '(:value u8))
; char
(67 '(:value u16))
; float
(70 '(:value vec 4))
; double
(68 '(:value vec 8))
; int. u32 will overflow. Can we use vec 4?
(73 '(:value vec 4))
; long
(74 '(:value vec 8))
; short
(83 '(:value u16))
; boolean
(90 '(:value u8))))
(setq spec `((:type u8) (:length u32) (:value repeat (:length) ,repeater)))
(bindat-unpack spec packet))))
(defconst jdwp-protocol
`((:name "version"
:command-set 1
:command 1
:command-spec nil
:reply-spec ((:description struct jdwp-string-spec)
(:jdwp-major u32)
(:jdwp-minor u32)
(:vm-version struct jdwp-string-spec)
(:vm-name struct jdwp-string-spec)))
(:name "classes-by-signature"
:command-set 1
:command 2
:command-spec ((:signature struct jdwp-string-spec))
:reply-spec ((:classes u32)
(:class repeat (:classes)
(:ref-type-tag u8)
(:type-id vec (eval jdwp-reference-type-id-size))
(:status u32))))
(:name "all-classes"
:command-set 1
:command 3
:command-spec nil
:reply-spec ((:classes u32)
(:class repeat (:classes)
(:ref-type-tag u8)
(:type-id vec (eval jdwp-reference-type-id-size))
(:signature struct jdwp-string-spec)
(:status u32))))
(:name "all-threads"
:command-set 1
:command 4
:command-spec nil
:reply-spec ((:threads u32)
(:thread repeat (:threads)
(:id vec (eval jdwp-object-id-size)))))
(:name "top-level-thread-groups"
:command-set 1
:command 5
:command-spec nil
:reply-spec ((:groups u32)
(:group repeat (:group)
(:id vec (eval jdwp-object-id-size)))))
(:name "dispose"
:command-set 1
:command 6
:command-spec nil
:reply-spec nil)
(:name "id-sizes"
:command-set 1
:command 7
:command-spec nil
:reply-spec ((:field-id-size u32)
(:method-id-size u32)
(:object-id-size u32)
(:reference-type-id-size u32)
(:frame-id-size u32)))
(:name "suspend"
:command-set 1
:command 8
:command-spec nil
:reply-spec nil)
(:name "resume"
:command-set 1
:command 9
:command-spec nil
:reply-spec nil)
(:name "exit"
:command-set 1
:command 10
:command-spec ((:exit-code u32))
:reply-spec nil)
(:name "capabilities-new"
:command-set 1
:command 17
:command-spec nil
:reply-spec ((:can-watch-field-modification u8)
(:can-watch-field-access u8)
(:can-get-bytecodes u8)
(:can-get-synthetic-attribute u8)
(:can-get-owned-monitor-info u8)
(:can-get-current-contended-monitor u8)
(:can-get-monitor-info u8)
(:can-redefine-class u8)
(:can-add-method u8)
(:can-unrestrictedly-redefine-class u8)
(:can-pop-frames u8)
(:can-use-instance-filters u8)
(:can-get-source-debug-extension u8)
(:can-request-vm-death-event u8)
(:can-set-default-stratum u8)))
(:name "all-classes-with-generic"
:command-set 1
:command 20
:command-spec nil
:reply-spec ((:classes u32)
(:class repeat (:classes)
(:ref-type-tag u8)
(:type-id vec (eval jdwp-reference-type-id-size))
(:signature struct jdwp-string-spec)
(:generic-signature struct jdwp-string-spec)
(:status u32))))
(:name "signature"
:command-set 2
:command 1
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:signature struct jdwp-string-spec)))
(:name "class-loader"
:command-set 2
:command 2
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:class-loader vec (eval jdwp-object-id-size))))
(:name "fields"
:command-set 2
:command 4
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:declared u32)
(:field repeat (:declared)
(:id vec (eval jdwp-field-id-size))
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:mod-bits u32))))
(:name "methods"
:command-set 2
:command 5
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:methods u32)
(:method repeat (:methods)
(:method-id vec (eval jdwp-method-id-size))
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:mod-bits u32))))
(:name "reference-get-values"
:command-set 2
:command 6
:command-spec ((:ref-type vec (eval jdwp-object-id-size))
(:fields u32)
(:field repeat (:fields)
(:id vec (eval jdwp-field-id-size))))
:reply-spec ((:values u32)
(:value repeat (:values)
(:value struct jdwp-value-spec))))
(:name "source-file"
:command-set 2
:command 7
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:source-file struct jdwp-string-spec)))
(:name "nested-types"
:command-set 2
:command 8
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:num-nested u32)
(:nested repeat (:num-nested)
(:ref-type-tag u8)
(:id vec (eval jdwp-reference-type-id-size)))))
(:name "interfaces"
:command-set 2
:command 10
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:interfaces u32)
(:interface repeat (:interfaces)
(:type vec (eval jdwp-reference-type-id-size)))))
(:name "class-object"
:command-set 2
:command 11
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:class-object vec (eval jdwp-object-id-size))))
(:name "signature-with-generic"
:command-set 2
:command 13
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:signature struct jdwp-string-spec)
(:generic-signature struct jdwp-string-spec)))
(:name "fields-with-generic"
:command-set 2
:command 14
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:declared u32)
(:field repeat (:declared)
(:id vec (eval jdwp-field-id-size))
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:generic-signature struct jdwp-string-spec)
(:mod-bits u32))))
(:name "methods-with-generic"
:command-set 2
:command 15
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:methods u32)
(:method repeat (:methods)
(:method-id vec (eval jdwp-method-id-size))
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:generic-signature struct jdwp-string-spec)
(:mod-bits u32))))
(:name "superclass"
:command-set 3
:command 1
:command-spec ((:class vec (eval jdwp-reference-type-id-size)))
:reply-spec ((:superclass vec (eval jdwp-reference-type-id-size))))
(:name "class-invoke-method"
:command-set 3
:command 3
:command-spec ((:class vec (eval jdwp-reference-type-id-size))
(:thread vec (eval jdwp-object-id-size))
(:method-id vec (eval jdwp-method-id-size))
(:arguments u32)
(:argument repeat (:arguments)
(:value struct jdwp-value-spec))
(:options u32))
:reply-spec ((:return-value struct jdwp-value-spec)
(:exception-type u8)
(:exception-object vec (eval jdwp-object-id-size))))
(:name "line-table"
:command-set 6
:command 1
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size))
(:method-id vec (eval jdwp-method-id-size)))
:reply-spec ((:start vec 8)
(:end vec 8)
(:lines u32)
(:line repeat (:lines)
(:line-code-index vec 8)
(:line-number u32))))
(:name "variable-table"
:command-set 6
:command 2
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size))
(:method-id vec (eval jdwp-method-id-size)))
:reply-spec ((:arg-cnt u32)
(:slots u32)
(:slot repeat (:slots)
(:code-index vec 8)
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:length u32)
(:slot u32))))
(:name "variable-table-with-generic"
:command-set 6
:command 5
:command-spec ((:ref-type vec (eval jdwp-reference-type-id-size))
(:method-id vec (eval jdwp-method-id-size)))
:reply-spec ((:arg-cnt u32)
(:slots u32)
(:slot repeat (:slots)
(:code-index vec 8)
(:name struct jdwp-string-spec)
(:signature struct jdwp-string-spec)
(:generic-signature struct jdwp-string-spec)
(:length u32)
(:slot u32))))
(:name "object-reference-type"
:command-set 9
:command 1
:command-spec ((:object vec (eval jdwp-object-id-size)))
:reply-spec ((:ref-type-tag u8)
(:type-id vec (eval jdwp-object-id-size))))
(:name "object-get-values"
:command-set 9
:command 2
:command-spec ((:object vec (eval jdwp-object-id-size))
(:fields u32)
(:field repeat (:fields)
(:id vec (eval jdwp-field-id-size))))
:reply-spec ((:values u32)
(:value repeat (:values)
(:value struct jdwp-value-spec))))
(:name "object-invoke-method"
:command-set 9
:command 6
:command-spec ((:object vec (eval jdwp-object-id-size))
(:thread vec (eval jdwp-object-id-size))
(:class vec (eval jdwp-reference-type-id-size))
(:method-id vec (eval jdwp-method-id-size))
(:arguments u32)
(:argument repeat (:arguments)
(:value struct jdwp-value-spec))
(:options u32))
:reply-spec ((:return-value struct jdwp-value-spec)
(:exception-type u8)
(:exception-object vec (eval jdwp-object-id-size))))
(:name "string-value"
:command-set 10
:command 1
:command-spec ((:object vec (eval jdwp-object-id-size)))
:reply-spec ((:value struct jdwp-string-spec)))
(:name "thread-name"
:command-set 11
:command 1
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec ((:thread-name struct jdwp-string-spec)))
(:name "thread-suspend"
:command-set 11
:command 2
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec nil)
(:name "thread-resume"
:command-set 11
:command 3
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec nil)
(:name "thread-status"
:command-set 11
:command 4
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec ((:thread-status u32)
(:suspend-status u32)))
(:name "thread-group"
:command-set 11
:command 5
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec ((:group vec (eval jdwp-object-id-size))))
(:name "frames"
:command-set 11
:command 6
:command-spec ((:thread vec (eval jdwp-object-id-size))
(:start-frame u32)
(:length u32))
:reply-spec ((:frames u32)
(:frame repeat (:frames)
(:id vec (eval jdwp-frame-id-size))
(:location struct jdwp-location-spec))))
(:name "frame-count"
:command-set 11
:command 7
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec ((:frame-count u32)))
(:name "suspend-count"
:command-set 11
:command 12
:command-spec ((:thread vec (eval jdwp-object-id-size)))
:reply-spec ((:suspend-count u32)))
(:name "thread-group-name"
:command-set 12
:command 1
:command-spec ((:group vec (eval jdwp-object-id-size)))
:reply-spec ((:group-name struct jdwp-string-spec)))
(:name "thread-group-parent"
:command-set 12
:command 2
:command-spec ((:group vec (eval jdwp-object-id-size)))
:reply-spec ((:parent-group vec (eval jdwp-object-id-size))))
(:name "thread-group-children"
:command-set 12
:command 3
:command-spec ((:group vec (eval jdwp-object-id-size)))
:reply-spec ((:child-threads u32)
(:child-thread repeat (:child-threads)
(:child-thread vec (eval jdwp-object-id-size)))
(:child-groups u32)
(:child-group repeat (:child-groups)
(:child-group vec (eval jdwp-object-id-size)))))
(:name "array-length"
:command-set 13
:command 1
:command-spec ((:array-object vec (eval jdwp-object-id-size)))
:reply-spec ((:array-length u32)))
(:name "array-get-values"
:command-set 13
:command 2
:command-spec ((:array-object vec (eval jdwp-object-id-size))
(:first-index u32)
(:length u32))
:reply-spec nil)
(:name "set"
:command-set 15
:command 1
:command-spec ((:event-kind u8)
(:suspend-policy u8)
(:modifiers u32)
(:modifier repeat (:modifiers)
(:mod-kind u8)
(:u union (:mod-kind)
(,jdwp-mod-kind-case-count (:count u32))
(,jdwp-mod-kind-class-match (:class-pattern struct jdwp-string-spec))
(,jdwp-mod-kind-location-only (:location struct jdwp-location-spec))
(,jdwp-mod-kind-exception-only (:exception vec (eval jdwp-reference-type-id-size))
(:caught u8)
(:uncaught u8))
(,jdwp-mod-kind-case-step (:thread vec (eval jdwp-object-id-size))
(:size u32)
(:depth u32)))))
:reply-spec ((:request-id u32)))
(:name "clear"
:command-set 15
:command 2
:command-spec ((:event u8)
(:request-id u32))
:reply-spec nil)
(:name "stack-frame-get-values"
:command-set 16
:command 1
:command-spec ((:thread vec (eval jdwp-object-id-size))
(:frame vec (eval jdwp-frame-id-size))
(:slots u32)
(:slot repeat (:slots)
(:slot u32)
(:sigbyte u8)))
:reply-spec ((:values u32)
(:value repeat (:values)
(:slot-value struct jdwp-value-spec))))
(:name "stack-frame-this-object"
:command-set 16
:command 3
:command-spec ((:thread vec (eval jdwp-object-id-size))
(:frame vec (eval jdwp-frame-id-size)))
:reply-spec ((:object-this struct jdwp-value-spec)))))
(defconst jdwp-handshake "JDWP-Handshake")
;;; And the functions:
(defun jdwp-string-to-hex (s &optional max)
(let ((hex))
(loop for c in (string-to-list s)
while (or (null max) (< (length hex) max))
do
(setf hex (concat hex (format "%02x " c))))
(if (= (length hex) 0)
""
(substring hex 0 -1))))
(defun jdwp-put (jdwp key value)
(setf (jdwp-plist jdwp)
(plist-put (jdwp-plist jdwp) key value)))
(defun jdwp-get (jdwp key)
(plist-get (jdwp-plist jdwp) key))
(defun jdwp-process-filter (process string)
(jdwp-debug "jdwp-process-filter")
(condition-case err
(progn
(jdwp-ordinary-insertion-filter process string)
(let ((jdwp (process-get process 'jdwp))
packet)
(while (setq packet (jdwp-packet-unpack (jdwp-residual-output jdwp)))
(jdwp-consume-output jdwp (jdwp-packet-length packet))
(jdwp-debug "jdwp-process-filter received packet:type=%s" (type-of packet))
(if (jdwp-packet-reply-p packet)
;; reply packet
(progn
(jdwp-trace "jdwp-process-filter:reply packet:%s" packet)
(jdwp-trace "jdwp-process-filter:reply packet data:%s" (jdwp-string-to-hex (jdwp-packet-data packet)))
(setf (jdwp-current-reply jdwp) packet))
(jdwp-debug "jdwp-process-filter:command-packet")
;; command packet
(jdibug-util-run-with-timer 0.1 nil 'jdwp-process-command jdwp packet)
(jdwp-trace "received command packet")))))
(error (jdwp-error "jdwp-process-filter:%s" err))))
(defun jdwp-process-id-sizes (jdwp reply)
(setf (jdwp-field-id-size jdwp) (bindat-get-field reply :field-id-size))
(jdwp-trace "field-id-size :%d" (jdwp-field-id-size jdwp))
(setf (jdwp-method-id-size jdwp) (bindat-get-field reply :method-id-size))
(jdwp-trace "method-id-size :%d" (jdwp-method-id-size jdwp))
(setf (jdwp-object-id-size jdwp) (bindat-get-field reply :object-id-size))
(jdwp-trace "object-id-size :%d" (jdwp-object-id-size jdwp))
(setf (jdwp-reference-type-id-size jdwp) (bindat-get-field reply :reference-type-id-size))
(jdwp-trace "reference-type-id-size:%d" (jdwp-reference-type-id-size jdwp))
(setf (jdwp-frame-id-size jdwp) (bindat-get-field reply :frame-id-size))
(jdwp-trace "frame-id-size :%d" (jdwp-frame-id-size jdwp)))
(defun jdwp-connect (jdwp server port)
"[ASYNC] returns t if connected and an (ERROR-SYMBOL . SIGNAL-DATA) if there are problems connecting"
(jdwp-trace "jdwp-connect:%s:%s" server port)
(let ((buffer-name (concat " jdwp-socket-buffer-" server "-" (number-to-string port))))
(if (get-buffer buffer-name) (kill-buffer buffer-name))
(setf (jdwp-server jdwp) server)
(setf (jdwp-port jdwp) port)
(setf (jdwp-process jdwp) (open-network-stream "jdwp" buffer-name server port))
(when (jdwp-process jdwp)
(process-put (jdwp-process jdwp) 'jdwp jdwp)
(set-process-sentinel (jdwp-process jdwp) 'jdwp-process-sentinel)
(with-current-buffer (process-buffer (jdwp-process jdwp))
(set-buffer-multibyte nil))
(set-process-coding-system (jdwp-process jdwp) 'no-conversion 'no-conversion)
(jdwp-process-send-string jdwp jdwp-handshake)
(let ((received (jdwp-receive-message (jdwp-process jdwp)
(lambda ()
(if (>= (jdwp-output-length jdwp) (length jdwp-handshake))
(jdwp-residual-output jdwp))))))
;; note that if the debuggee is started with suspend=y
;; we will get a command packet straight away after the handshake packet
;; so we will need to do substring for the comparison
(unless (string= jdwp-handshake (substring received 0 (length jdwp-handshake)))
(error "Handshake error:%s" received)))
(jdwp-consume-output jdwp (length jdwp-handshake))
;; only after the handshake we use the process filter
(set-process-filter (jdwp-process jdwp) 'jdwp-process-filter)
(jdwp-process-id-sizes jdwp (jdwp-send-command jdwp "id-sizes" nil))
jdwp)))
(defun jdwp-disconnect (jdwp)
(condition-case err
(jdwp-send-command jdwp "dispose" nil)
(error nil))
(when (jdwp-process jdwp)
(setf (process-sentinel (jdwp-process jdwp)) nil)
(kill-buffer (process-buffer (jdwp-process jdwp))))
;;(delete-process (jdwp-process jdwp))
(setf (jdwp-process jdwp) nil))
(defun jdwp-exit (jdwp command)
(condition-case err
(jdwp-send-command jdwp "exit" command)
(error (jdwp-error "Error executing exit command: %s" err)))
(when (jdwp-process jdwp)
(setf (process-sentinel (jdwp-process jdwp)) nil)
(kill-buffer (process-buffer (jdwp-process jdwp))))
;;(delete-process (jdwp-process jdwp))
(setf (jdwp-process jdwp) nil))
(defun jdwp-process-sentinel (proc string)
(let ((jdwp (process-get proc 'jdwp)))
(jdwp-debug "jdwp-process-sentinel:%s" string)
(eval
`(jdwp-uninterruptibly
(run-hook-with-args 'jdwp-event-hooks ,jdwp jdwp-event-vm-death)))))
(defun jdwp-process-reply (jdwp packet command-data)
(jdwp-debug "jdwp-process-reply")
(jdwp-with-size
jdwp
(let* ((id (jdwp-packet-id packet))
(error-code (jdwp-packet-reply-error packet))
(protocol (jdwp-get-protocol (cdr (assoc :name command-data))))
(reply-spec (getf protocol :reply-spec)))
(jdwp-trace "jdwp-process-reply packet-header:%s" packet)
(jdwp-debug "jdwp-process-reply reply-spec:%s" reply-spec)
(jdwp-debug "jdwp-process-reply data:%s (%d bytes)" (jdwp-packet-data packet) (length (jdwp-packet-data packet)))
(if (not (= error-code 0))
(progn
(jdwp-traffic-info "reply(error): %s %s" (jdwp-packet-data packet) packet)
(jdwp-error "jdwp-process-reply: received error:%d:%s for id:%d command:%s" error-code (jdwp-error-string error-code) id (getf protocol :name))
(if (memq error-code jdwp-ignore-error) nil (error "%s" (jdwp-error-string error-code))))
(if reply-spec
(let ((reply-data (bindat-unpack reply-spec (jdwp-packet-data packet))))
(jdwp-traffic-info "reply: %s" reply-data)
(jdwp-info "jdwp-process-reply:id:%5s command:[%20s] time:%-6s len:%5s error:%1d"
id
(getf protocol :name)
(float-time (time-subtract (current-time) (cdr (assoc :sent-time command-data))))
(jdwp-packet-length packet)
error-code)
(jdwp-info "reply-data:%s" (elog-trim reply-data 100))
reply-data)
;; special case for array, we return the string so the caller can call unpack-arrayregion
(jdwp-traffic-info "reply: [no reply-spec]")
(jdwp-packet-data packet))))))
(defvar jdwp-event-hooks nil)
(defvar jdwp-throw-on-input-pending nil
"When set to non-nil, jdwp-send-command will throw an error on user input.")
(defvar jdwp-input-pending nil
"The symbol that will be thrown when jdwp-throw-on-input-pending is non-nil and there's input pending")
(defun jdwp-process-command (jdwp packet)
(jdwp-debug "jdwp-process-command")
(jdwp-with-size
jdwp
(let ((command-set (jdwp-packet-command-command-set packet))
(command (jdwp-packet-command-command packet))
(id (jdwp-packet-id packet))
(flags (jdwp-packet-flags packet)))
(if (and (= command-set 64) (= command 100))
(let* ((packet (bindat-unpack jdwp-event-spec (jdwp-packet-data packet)))
(suspend-policy (bindat-get-field packet :suspend-policy))
(events (bindat-get-field packet :events)))
(jdwp-info "event suspend-policy:%d events:%d" suspend-policy events)
(jdwp-trace "event:%s" (bindat-get-field packet :event))
(jdwp-traffic-info "event: %s" packet)
(dolist (event (bindat-get-field packet :event))
(eval `(jdwp-uninterruptibly
(run-hook-with-args 'jdwp-event-hooks ,jdwp (quote ,event))))))
(jdwp-error "do not know how to handle command-set %d command %d" command-set command)))))
(defun jdwp-reply-packet-p (str)
(let* ((packet (bindat-unpack jdwp-packet-spec str))
(flags (bindat-get-field packet :flags)))
(= flags #x80)))
(defun jdwp-ordinary-insertion-filter (proc string)
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
;; Insert the text, advancing the process marker.
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc))))))
(defun jdwp-consume-output (jdwp len)
(jdwp-debug "jdwp-consume-output:len=%s" len)
(when (jdwp-process jdwp)
(with-current-buffer (process-buffer (jdwp-process jdwp))
(goto-char (point-min))
(delete-char len))))
(defun jdwp-residual-output (jdwp)
(when (jdwp-process jdwp)
(let* ((proc (jdwp-process jdwp))
(buf (process-buffer proc)))